J
Joe Black
Hi
I create email using code below. Email gets sent but when I open the email
from Sent Items in Outlook, the email body is completely blank - no text at
all. The recipient can read the email when it arrives with no problems, but
I can't.
Any ideas?
'************************
Option Compare Database
Option Explicit
Public Sub SendTheMessage(ByVal DisplayMsg As Boolean, ByVal strAddress As
String, Optional AttachmentPath As String, Optional HTMLBodyText As String,
Optional MsgSubject As String)
Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objOutlookMAPI As Object
Dim objOutlookRecip As Object
On Error GoTo Oops
On Error GoTo 0
Set objOutlook = GetObject("", "Outlook.Application")
Set objOutlookMAPI = objOutlook.GetNamespace("MAPI")
Set objOutlookMsg = objOutlook.CreateItem(0)
'Redemption
Dim SafeItem
Set SafeItem = CreateObject("Redemption.SafeMailItem")
SafeItem.Item = objOutlookMsg
With SafeItem
Set objOutlookRecip = .Recipients.Add(strAddress)
objOutlookRecip.Type = 1
If Not IsMissing(MsgSubject) Then .Subject = MsgSubject
If Not IsMissing(HTMLBodyText) Then
If Len(Trim(HTMLBodyText)) > 0 Then .HTMLBody = HTMLBodyText
End If
If DisplayMsg Then
.Display
Else
.Send
End If
End With
Cleanup:
Set SafeItem = Nothing
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlookRecip = Nothing
Set objOutlookMAPI = Nothing
Set btn = Nothing
Set objExplorer = Nothing
Exit Sub
Oops:
MsgBox "Error number " & Err.Number & ": " & Err.Description
Resume Cleanup
End Sub
I create email using code below. Email gets sent but when I open the email
from Sent Items in Outlook, the email body is completely blank - no text at
all. The recipient can read the email when it arrives with no problems, but
I can't.
Any ideas?
'************************
Option Compare Database
Option Explicit
Public Sub SendTheMessage(ByVal DisplayMsg As Boolean, ByVal strAddress As
String, Optional AttachmentPath As String, Optional HTMLBodyText As String,
Optional MsgSubject As String)
Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objOutlookMAPI As Object
Dim objOutlookRecip As Object
On Error GoTo Oops
On Error GoTo 0
Set objOutlook = GetObject("", "Outlook.Application")
Set objOutlookMAPI = objOutlook.GetNamespace("MAPI")
Set objOutlookMsg = objOutlook.CreateItem(0)
'Redemption
Dim SafeItem
Set SafeItem = CreateObject("Redemption.SafeMailItem")
SafeItem.Item = objOutlookMsg
With SafeItem
Set objOutlookRecip = .Recipients.Add(strAddress)
objOutlookRecip.Type = 1
If Not IsMissing(MsgSubject) Then .Subject = MsgSubject
If Not IsMissing(HTMLBodyText) Then
If Len(Trim(HTMLBodyText)) > 0 Then .HTMLBody = HTMLBodyText
End If
If DisplayMsg Then
.Display
Else
.Send
End If
End With
Cleanup:
Set SafeItem = Nothing
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlookRecip = Nothing
Set objOutlookMAPI = Nothing
Set btn = Nothing
Set objExplorer = Nothing
Exit Sub
Oops:
MsgBox "Error number " & Err.Number & ": " & Err.Description
Resume Cleanup
End Sub