M
maceslin
I have modified the following code from another source and get an
error "Automation error- server threw an exception. I have done some
research online but think, make that I know I am way over my head.
Some very specific help would be appreciated.
I have active hyperlinks that I need to maintain which is why I am
emailing a form rather than sending a report using Access 2003. Other
suggegstions to send this data will be considered
Private Sub cmdEmailForm_Click()
Dim rst As DAO.Recordset
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strMessage As String
Dim strTableBeg As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strFntHeader As String
Dim strFntEnd As String
Dim strEmailSQL As String
Dim strEmailSelect As String
Dim strEmailFrom As String
Dim strEmailWhere As String
' build sql statement
strEmailSelect = "Select tblComments.solution, tblBasicData.
[Lesson IDPK], tblNumbered.Numbered_Fleet, tblStatusChoices.Status,
tblComments.Date_Entered, tblBasicData.HyperlinkToLesson,
tblDOTMLPF.DOTMLPF_Choices"
strEmailFrom = "FROM tblDOTMLPF INNER JOIN (qryLastEntry INNER
JOIN (tblStatusChoices INNER JOIN (tblNumbered INNER JOIN
(tblBasicData INNER JOIN tblComments ON tblBasicData.[Lesson IDPK] =
tblComments.Lesson_IDFK) ON tblNumbered.NumberFleetPK =
tblBasicData.NumberedFleetFK) ON tblStatusChoices.StatusChoiceIDPK =
tblComments.statusFK) ON (qryLastEntry.Lesson_IDFK =
tblComments.Lesson_IDFK) AND (qryLastEntry.MaxOfDate_Entered =
tblComments.Date_Entered) AND (qryLastEntry.DOTLMPF_ChoiceFK =
tblComments.DOTLMPF_ChoiceFK)) ON tblDOTMLPF.[DOTMLPF ID PK] =
tblComments.DOTLMPF_ChoiceFK"
strEmailWhere = " Where Numbered_Fleet=""" & Forms![frmPara1]!
[cboNumbered] & """"
strEmailSQL = strEmailSelect & " " & strEmailFrom & " " &
strEmailWhere
'Define format for output
strTableBeg = "<table border=0>"
strTableEnd = "</table>"
strFntHeader = "<font size=2 face=" & Chr(34) & "Arial" & Chr(34)
& "><b>" & _
"<tr bgcolor=lightblue>" & _
"<td nowrap>Lesson ID</td>" & _
"<td>Hyperlink to Lesson</td>" & _
"<td>DOTMLPF</td>" & _
"<td>Most recent comment</td>" & _
"<td>Status</td>" & _
"<td>Date Entered</td>" & _
"</tr></b></font>"
strFntNormal = "<font color=black face=" & Chr(34) & "Arial" &
Chr(34) & " size=1>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset(strEmailSQL)
'Build HTML Output for the DataSet
strMessage = strTableBeg & strFntNormal & strFntHeader
'need to test with Outlook
Do Until rst.EOF
strMessage = strMessage & _
"<tr>" & _
"<td>" & rst![LessonID PK] & "</td>" & _
"<td>" & rst!HyperlinkToLesson & "</td>" &
_
"<td>" & rst!DOTMLPF_Choices & "</td>" & _
"<td>" & rst!solution & "</td>" & _
"<td>" & rst!status & "</td>" & _
"<td>" & rst!Date_Entered & "</td>" & _
"</tr>"
rst.MoveNext
Loop
strMessage = strMessage & strFntEnd & strTableEnd
rst.Close
Set rst = Nothing
'Create e-mail item
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.to = " "
.Subject = "Status of Information Operations submissions to
the NLLS"
' On Error Resume Next
********** the following line throws the code, everything else returns
expected value sin local
window****************************************** .
BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>" & strFntNormal & strMessage & " </
BODY></HTML>"
.Display
End With
End Sub
Thanks
Dave
error "Automation error- server threw an exception. I have done some
research online but think, make that I know I am way over my head.
Some very specific help would be appreciated.
I have active hyperlinks that I need to maintain which is why I am
emailing a form rather than sending a report using Access 2003. Other
suggegstions to send this data will be considered
Private Sub cmdEmailForm_Click()
Dim rst As DAO.Recordset
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strMessage As String
Dim strTableBeg As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strFntHeader As String
Dim strFntEnd As String
Dim strEmailSQL As String
Dim strEmailSelect As String
Dim strEmailFrom As String
Dim strEmailWhere As String
' build sql statement
strEmailSelect = "Select tblComments.solution, tblBasicData.
[Lesson IDPK], tblNumbered.Numbered_Fleet, tblStatusChoices.Status,
tblComments.Date_Entered, tblBasicData.HyperlinkToLesson,
tblDOTMLPF.DOTMLPF_Choices"
strEmailFrom = "FROM tblDOTMLPF INNER JOIN (qryLastEntry INNER
JOIN (tblStatusChoices INNER JOIN (tblNumbered INNER JOIN
(tblBasicData INNER JOIN tblComments ON tblBasicData.[Lesson IDPK] =
tblComments.Lesson_IDFK) ON tblNumbered.NumberFleetPK =
tblBasicData.NumberedFleetFK) ON tblStatusChoices.StatusChoiceIDPK =
tblComments.statusFK) ON (qryLastEntry.Lesson_IDFK =
tblComments.Lesson_IDFK) AND (qryLastEntry.MaxOfDate_Entered =
tblComments.Date_Entered) AND (qryLastEntry.DOTLMPF_ChoiceFK =
tblComments.DOTLMPF_ChoiceFK)) ON tblDOTMLPF.[DOTMLPF ID PK] =
tblComments.DOTLMPF_ChoiceFK"
strEmailWhere = " Where Numbered_Fleet=""" & Forms![frmPara1]!
[cboNumbered] & """"
strEmailSQL = strEmailSelect & " " & strEmailFrom & " " &
strEmailWhere
'Define format for output
strTableBeg = "<table border=0>"
strTableEnd = "</table>"
strFntHeader = "<font size=2 face=" & Chr(34) & "Arial" & Chr(34)
& "><b>" & _
"<tr bgcolor=lightblue>" & _
"<td nowrap>Lesson ID</td>" & _
"<td>Hyperlink to Lesson</td>" & _
"<td>DOTMLPF</td>" & _
"<td>Most recent comment</td>" & _
"<td>Status</td>" & _
"<td>Date Entered</td>" & _
"</tr></b></font>"
strFntNormal = "<font color=black face=" & Chr(34) & "Arial" &
Chr(34) & " size=1>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset(strEmailSQL)
'Build HTML Output for the DataSet
strMessage = strTableBeg & strFntNormal & strFntHeader
'need to test with Outlook
Do Until rst.EOF
strMessage = strMessage & _
"<tr>" & _
"<td>" & rst![LessonID PK] & "</td>" & _
"<td>" & rst!HyperlinkToLesson & "</td>" &
_
"<td>" & rst!DOTMLPF_Choices & "</td>" & _
"<td>" & rst!solution & "</td>" & _
"<td>" & rst!status & "</td>" & _
"<td>" & rst!Date_Entered & "</td>" & _
"</tr>"
rst.MoveNext
Loop
strMessage = strMessage & strFntEnd & strTableEnd
rst.Close
Set rst = Nothing
'Create e-mail item
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.to = " "
.Subject = "Status of Information Operations submissions to
the NLLS"
' On Error Resume Next
********** the following line throws the code, everything else returns
expected value sin local
window****************************************** .
BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>" & strFntNormal & strMessage & " </
BODY></HTML>"
.Display
End With
End Sub
Thanks
Dave