[AccessD] Send email with Word attachment from Access

Bob Gajewski rbgajewski at roadrunner.com
Sun Oct 30 08:34:27 CDT 2011


Hi Folks
 
I've hit a wall, and could use some direction.
 
I have an Access 2003 application that records student course results, and
on that form, I would like to be able to (1) print a certificate, (2) save
the certificate as a Word 2003 document with a unique file name, and (3)
email the document to the student. Note: I have Access 2003 and Word 2010
installed.
 
I have items 1 and 2 working perfectly. My trouble is with item 3 - I just
can't seem to find the right commands/syntax to open Outlook. I've been
researching this for hours on Microsoft's sites and throughout the Internet
... with little success.
 
If anyone has ideas or suggestions, they would be most appreciated. 
 
Thanks
Bob Gajewski
 
<code in form>
----------------------------------------------------------------------------
-----------------
Private Sub cmdPrintCertificate_Click()
Call PrintCertificate(CourseID.Column(1) & CourseDays,
Trim(StudentFullNameFMLS), Format(StudentCourseStartDate, "mmmm d, yyyy"),
Format(StudentCourseEndDate, "mmmm d, yyyy"), Trim(InstructorFullNameFMLS))
End Sub

----------------------------------------------------------------------------
-----------------
Private Sub cmdEmailCertificate_Click()
Call EmailCertificate(CourseID.Column(1) & CourseDays,
Trim(StudentFullNameFMLS), Format(StudentCourseStartDate, "mmmm d, yyyy"),
Format(StudentCourseEndDate, "mmmm d, yyyy"), Trim(InstructorFullNameFMLS),
CourseID.Column(2), StudentMailTo)
End Sub
</code>
----------------------------------------------------------------------------
-----------------
<code in module>
Function PrintCertificate(varCourseCode, varStudentFullNameFMLS,
varCourseStartDate, varCourseEndDate, varInstructorFullNameFMLS)
' Start Microsoft Word
    Dim objWord As Object
    Set objWord = CreateObject("Word.Application")
    Dim strCertificate As String
        strCertificate = "C:\{actual path removed for security reasons}\" &
varCourseCode & ".dot"
        objWord.Documents.Open strCertificate
        objWord.Visible = True
With objWord
' Move to each bookmark and insert text from the form.
    .ActiveDocument.Bookmarks("StudentFullNameFMLS").Select
    .Selection.Text = CStr(varStudentFullNameFMLS)
    If Not varCourseStartDate = varCourseEndDate Then
        .ActiveDocument.Bookmarks("CourseStartDate").Select
        .Selection.Text = CStr(varCourseStartDate)
    End If
    .ActiveDocument.Bookmarks("CourseEndDate").Select
    .Selection.Text = CStr(varCourseEndDate)
End With
' Print the document in the foreground so Microsoft Word will not close
until the document finishes printing.
    objWord.ActiveDocument.PrintOut
    Do While objWord.BackgroundPrintingStatus > 0
    Loop
' Save the document
    objWord.ActiveDocument.SaveAs FileName:="C:\{actual path removed for
security reasons}\Certificates\" & _
        varStudentFullNameFMLS & "-" & varCourseCode & "-" &
Format(varCourseEndDate, "yyyymmdd") & ".doc"
' Close the document without saving changes.
    objWord.ActiveDocument.Close False
' Quit Microsoft Word and release the object variable.
    objWord.Quit
    Set objWord = Nothing
Exit Function
End Function
----------------------------------------------------------------------------
-----------------
Function EmailCertificate(varCourseCode, varStudentFullNameFMLS,
varCourseStartDate, varCourseEndDate, varInstructorFullNameFMLS,
varCourseName, varStudentMailTo)
' Start Microsoft Word
    Dim objWord As Object
    Set objWord = CreateObject("Word.Application")
    Dim strCertificate As String
        strCertificate = "C:\{actual path removed for security reasons}\" &
varCourseCode & ".dot"
        objWord.Documents.Open strCertificate
        objWord.Visible = True
With objWord
' Move to each bookmark and insert text from the form.
    .ActiveDocument.Bookmarks("StudentFullNameFMLS").Select
    .Selection.Text = CStr(varStudentFullNameFMLS)
    If Not varCourseStartDate = varCourseEndDate Then
        .ActiveDocument.Bookmarks("CourseStartDate").Select
        .Selection.Text = CStr(varCourseStartDate)
    End If
    .ActiveDocument.Bookmarks("CourseEndDate").Select
    .Selection.Text = CStr(varCourseEndDate)
End With
' Save the document
    objWord.ActiveDocument.SaveAs FileName:="C:\Users\{actual path removed
for security reasons}\Certificates\" & _
        varStudentFullNameFMLS & "-" & varCourseCode & "-" &
Format(varCourseEndDate, "yyyymmdd") & ".doc"
' Send the document by email
    Dim bStarted As Boolean
    Dim oOutlookApp As Object
    Dim oItem As Object
    On Error Resume Next
    If Len(objWord.ActiveDocument.Path) = 0 Then 'Document has not been
saved
         objWord.ActiveDocument.Save 'so save it
    End If
    'see if Outlook is running and if so turn your attention there
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then 'Outlook isn't running
         'So fire it up
         Set oOutlookApp = CreateObject("Outlook.Application")
         bStarted = True
         oOutlookApp.Visible = True
    End If
    'Open a new e-mail message
    Set oItem = oOutlookApp.CreateItem()    ***** This seems to be where the
code fails *****
    With oItem 'and add the detail to it
         .To = varStudentMailTo 'send to this address
         .Subject = "Training Certificate" 'This is the message subject
         .Body = "Attached is your training certificate for the " & _
            varCourseName & " that you completed on " &
Format(varCourseEndDate, "mmmm d, yyyy") & "." ' This is the message body
text
         .Attachments.Add Source:=objWord.ActiveDocument.FullName
         '.Send
         .Display
    End With
    ' If the macro started Outlook, stop it again.
    If bStarted Then
         oOutlookApp.Quit
    End If
    ' Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing
' Close the document without saving changes.
    objWord.ActiveDocument.Close False
' Quit Microsoft Word and release the object variable.
    objWord.Quit
    Set objWord = Nothing
Exit Function
End Function
</code>
 



More information about the AccessD mailing list