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>