I
Ian Ramsey via OfficeKB.com
Hi all,
I'm having a problem using Redemption to send a message created from an existing HTML mail template in Outlook 2002. The code is given below. You can ignore the first chunk and the assigning of the recipient's address - that all works for the standard Outlook mail item which can be displayed correctly. It's when I come to reference the newly-created SafeMailItem to the reply message right at the end that I get the error message "Object variable or With block variable not set". I'm a newbie at Outlook VBA and Redemption so please forgive me if I've missed something simple. Many thanks in advance for any help here.
Public Sub ProcessMail()
Dim myOLApp As Outlook.Application
Set myOLApp = New Outlook.Application
Dim myNS As NameSpace
Dim myInbox As MAPIFolder
Dim f1 As MAPIFolder
Dim f2 As MAPIFolder
Dim f3 As MAPIFolder
Dim f4 As MAPIFolder
Dim MoveFrom As MAPIFolder
Dim MoveTo As MAPIFolder
Dim msg As Object
Dim objSafeReply As Redemption.SafeMailItem
Dim MyReplyMessage As Object
Dim NumberToMove As Integer
Dim myReplyTo As String
Dim idx As Integer
' Initialize variables.
NumberToMove = 0
' Get a reference to the Inbox.
Set myNS = GetNamespace("MAPI")
Set myInbox = myNS.GetDefaultFolder(olFolderInbox)
' Get a reference to the destination folder.
Set MoveFrom = Nothing
Set MoveTo = Nothing
For Each f1 In myNS.Folders
For Each f2 In f1.Folders
If f2.Name = "Initial Reply Awaiting" Then
Set MoveFrom = f2
End If
Next
Next
For Each f3 In myNS.Folders
For Each f4 In f3.Folders
If f4.Name = "Initial Reply Sent" Then
Set MoveTo = f4
End If
Next
Next
' If the destination folder wasn't found, display
' a message and then clean up and exit.
If MoveFrom Is Nothing Then
MsgBox "The source folder does not exist."
Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Set f4 = Nothing
Set myNS = Nothing
Set myInbox = Nothing
Exit Sub
End If
If MoveTo Is Nothing Then
MsgBox "The destination folder does not exist."
Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Set f4 = Nothing
Set myNS = Nothing
Set myInbox = Nothing
Exit Sub
End If
' Loop through all messages in the MoveFrom directory.
For Each msg In MoveFrom.Items
' Process only mail messages.
If TypeOf msg Is MailItem Then
If msg.UnRead = True Then
NumberToMove = NumberToMove + 1
Set MyReplyMessage = myOLApp.CreateItemFromTemplate("c:\Documents and Settings\Ian Ramsey\Application Data\Microsoft\Templates\Mallorca Initial Reply.oft")
'Gets the address to reply to (function given below, but it works!)
myReplyTo = R_GetSenderAddress(msg)
'Assigns the address
MyReplyMessage.To = myReplyTo
'Creates SafeMail object
Set objSafeReply = CreateObject("Redemption.SafeMailItem")
'References constructed mail - IT GOES WRONG HERE!
Set objSafeReply.Item = MyReplyMessage
objSafeReply.Send
End If
End If
Next
End Sub
Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE ' Redemption.AddressEntry
Dim objSMail ' Redemption.SafeMailItem
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E
Set objSMail = CreateObject("Redemption.SafeMailItem")
objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)
Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
End If
End If
Set objSenderAE = Nothing
Set objSMail = Nothing
End Function
I'm having a problem using Redemption to send a message created from an existing HTML mail template in Outlook 2002. The code is given below. You can ignore the first chunk and the assigning of the recipient's address - that all works for the standard Outlook mail item which can be displayed correctly. It's when I come to reference the newly-created SafeMailItem to the reply message right at the end that I get the error message "Object variable or With block variable not set". I'm a newbie at Outlook VBA and Redemption so please forgive me if I've missed something simple. Many thanks in advance for any help here.
Public Sub ProcessMail()
Dim myOLApp As Outlook.Application
Set myOLApp = New Outlook.Application
Dim myNS As NameSpace
Dim myInbox As MAPIFolder
Dim f1 As MAPIFolder
Dim f2 As MAPIFolder
Dim f3 As MAPIFolder
Dim f4 As MAPIFolder
Dim MoveFrom As MAPIFolder
Dim MoveTo As MAPIFolder
Dim msg As Object
Dim objSafeReply As Redemption.SafeMailItem
Dim MyReplyMessage As Object
Dim NumberToMove As Integer
Dim myReplyTo As String
Dim idx As Integer
' Initialize variables.
NumberToMove = 0
' Get a reference to the Inbox.
Set myNS = GetNamespace("MAPI")
Set myInbox = myNS.GetDefaultFolder(olFolderInbox)
' Get a reference to the destination folder.
Set MoveFrom = Nothing
Set MoveTo = Nothing
For Each f1 In myNS.Folders
For Each f2 In f1.Folders
If f2.Name = "Initial Reply Awaiting" Then
Set MoveFrom = f2
End If
Next
Next
For Each f3 In myNS.Folders
For Each f4 In f3.Folders
If f4.Name = "Initial Reply Sent" Then
Set MoveTo = f4
End If
Next
Next
' If the destination folder wasn't found, display
' a message and then clean up and exit.
If MoveFrom Is Nothing Then
MsgBox "The source folder does not exist."
Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Set f4 = Nothing
Set myNS = Nothing
Set myInbox = Nothing
Exit Sub
End If
If MoveTo Is Nothing Then
MsgBox "The destination folder does not exist."
Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Set f4 = Nothing
Set myNS = Nothing
Set myInbox = Nothing
Exit Sub
End If
' Loop through all messages in the MoveFrom directory.
For Each msg In MoveFrom.Items
' Process only mail messages.
If TypeOf msg Is MailItem Then
If msg.UnRead = True Then
NumberToMove = NumberToMove + 1
Set MyReplyMessage = myOLApp.CreateItemFromTemplate("c:\Documents and Settings\Ian Ramsey\Application Data\Microsoft\Templates\Mallorca Initial Reply.oft")
'Gets the address to reply to (function given below, but it works!)
myReplyTo = R_GetSenderAddress(msg)
'Assigns the address
MyReplyMessage.To = myReplyTo
'Creates SafeMail object
Set objSafeReply = CreateObject("Redemption.SafeMailItem")
'References constructed mail - IT GOES WRONG HERE!
Set objSafeReply.Item = MyReplyMessage
objSafeReply.Send
End If
End If
Next
End Sub
Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE ' Redemption.AddressEntry
Dim objSMail ' Redemption.SafeMailItem
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E
Set objSMail = CreateObject("Redemption.SafeMailItem")
objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)
Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
End If
End If
Set objSenderAE = Nothing
Set objSMail = Nothing
End Function