jack drawbridge
jackandpat.d at gmail.com
Sun Oct 30 09:04:50 CDT 2011
Bob,
There's a sample here
http://www.blueclaw-db.com/download/download_access_email_example.htm
On Sun, Oct 30, 2011 at 9:34 AM, Bob Gajewski <rbgajewski at roadrunner.com>wrote:
> 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>
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>