I am developing an application in Access 2003 and need to send an email through Outlook based on the information entered on the form. Everything works except that the email is being sent as plain text so none of the formatting is retained. Also, I can't figure out how to get Outlook to pick up the autosignature.
The script I'm using is:
Expand|Select|Wrap|Line Numbers
- Private Sub cmdSendEmail_Click()
- On Error GoTo StartError
- Dim stLinkCriteria As String
- Dim stSubject As String
- Dim sthtmlBody As String
- Dim objItem As Object
- Dim objInsp As Outlook.Inspector
- ' requires a project reference to the
- ' Microsoft Word library
- Dim objDoc As Word.Document
- Dim objSel As Word.Selection
- Dim objCB As Office.CommandBar
- Dim objCBP As Office.CommandBarPopup
- Dim objCBB As Office.CommandBarButton
- Dim colCBControls As Office.CommandBarControls
- 'insert autosig
- Set objInsp = Application.ActiveInspector
- If Not objInsp Is Nothing Then
- Set objItem = objInsp.CurrentItem
- If objItem.Class = olMail Then ' editor is WordMail
- If objInsp.EditorType = olEditorWord Then
- ' next statement will trigger security prompt
- ' in Outlook 2002 SP3
- Set objDoc = objInsp.WordEditor
- Set objSel = objDoc.Application.Selection
- If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then
- objDoc.Bookmarks.Add Range:=objSel.Range, name:="_MailAutoSig"
- End If
- objSel.GoTo What:=wdGoToBookmark, name:="_MailAutoSig"
- Set objCB = objDoc.CommandBars("AutoSignature Popup")
- If Not objCB Is Nothing Then
- Set colCBControls = objCB.Controls
- End If
- Else ' editor is not WordMail
- get the Insert | Signature submenu
- Set objCBP = Application.ActiveInspector.CommandBars.FindControl(, 31145)
- If Not objCBP Is Nothing Then
- Set colCBControls = objCBP.Controls
- End If
- End If
- End If
- If Not colCBControls Is Nothing Then
- For Each objCBB In colCBControls
- If objCBB.Caption = strSigName Then
- objCBB.Execute ' **** see remarks
- Exit For
- End If
- End If
- End If
- If IsNull([ContactMode]) Or ([ContactMode]) = "" Then
- MsgBox "No email is specified."
- ElseIf IsNull([Purpose]) Or ([Purpose]) = "" Then
- MsgBox "There is no subject line."
- ElseIf IsNull([Action]) Or ([Action]) = "" Then
- MsgBox "The email body is empty."
- Exit Sub
- Else
- stLinkCriteria = Me![ContactMode]
- stSubject = Me![Purpose]
- sthtmlBody = Me![Action]
- DoCmd.SendObject acSendNoObject, , , stLinkCriteria, , , stSubject, sthtmlBody
- End If
- Set objInsp = Nothing
- Set objItem = Nothing
- Set objDoc = Nothing
- Set objSel = Nothing
- Set objCB = Nothing
- Set objCBB = Nothing
- StartError:
- MsgBox "No email was sent."
- Exit Sub
- End Sub