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>