Hello All,
So I have been trying all day to get the .SaveSentMessageFolder functionality to work with absolutely no luck. What I am trying to do is from Excel run a macro that auto-generates a pre-populated email, and then based on the customer name automatically placed that sent email into a respective Outlook Data File folder. I have not even had any luck though trying to get the .SaveSentMessageFolder functionality to work on changing the location of a local folder since I figured I would start there and work my way up to the Outlook Data File folder hierarchy. I have redacted some of the below that would be of no value such as defining some variables, but what I am currently getting is a Run-time error ‘422” Object Required on the Set MailItem.SaveSentMessageFolder = OutDestFolder line.
I also tried using .SaveSentMessageFolder = OutDestFolder and recieved a Run-time error '2147024891 (800070005)' You don't have appropriate permission to perform this operation. If I remove that line entirely the program runs and geenrates an email as planned but it still saves the sent email to the sent folder and has use Default Folder selected under the "Save Sent Item To" selection. Thanks for the help!!
Sub ExampleGenerateSalesEmail()
'Written by Josh Valenti on 10-01-19
'Purpose - Expedite Sales Email Creation
Dim OutDestFolder As Outlook.MAPIFolder
Dim itEmail As Outlook.MailItem
Dim Session As Outlook.Namespace
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim strSignatureFile As String
Dim objFileSystem As Object
Dim objTextStream As Object
Dim strSignature As String
Application.ScreenUpdating = False
StartCell = ActiveCell.Address
'Skipped Defining of FullName, FirstName, CompanyShortName, FileLocation, VersionVal, stRecipient, StBody
Application.DisplayAlerts = False
Set apOutlook = CreateObject("Outlook.Application")
Set Session = apOutlook.GetNamespace("MAPI")
''''''
apOutlook.Session.Logon
Set itEmail = apOutlook.CreateItem(olMailItem)
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
End If
strSignatureFile = "C:\Users\vajo5001\AppData\Roaming\Microsoft\Signatures\SaEM Sign with Opt Out no HC.htm"
'Read the specific signature file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFileSystem.OpenTextFile(strSignatureFile)
strSignature = objTextStream.ReadAll
With itEmail
.HTMLBody = strSignature
.Display
End With
Signature = itEmail.HTMLBody
StBody = "" & StBody
Set OutDestFolder = Session.GetDefaultFolder(olFolderDeletedItems)
With itEmail
.To = stRecipient
.CC = "example.email@example.com"
.Subject = stSubject
.HTMLBody = StBody & & Signature
.Display
.DeferredDeliveryTime = Date + 1 & " 10:45 AM" ' Deliver After 10:45 AM Next Day
Set MailItem.SaveSentMessageFolder = OutDestFolder
End With
End Sub
So I have been trying all day to get the .SaveSentMessageFolder functionality to work with absolutely no luck. What I am trying to do is from Excel run a macro that auto-generates a pre-populated email, and then based on the customer name automatically placed that sent email into a respective Outlook Data File folder. I have not even had any luck though trying to get the .SaveSentMessageFolder functionality to work on changing the location of a local folder since I figured I would start there and work my way up to the Outlook Data File folder hierarchy. I have redacted some of the below that would be of no value such as defining some variables, but what I am currently getting is a Run-time error ‘422” Object Required on the Set MailItem.SaveSentMessageFolder = OutDestFolder line.
I also tried using .SaveSentMessageFolder = OutDestFolder and recieved a Run-time error '2147024891 (800070005)' You don't have appropriate permission to perform this operation. If I remove that line entirely the program runs and geenrates an email as planned but it still saves the sent email to the sent folder and has use Default Folder selected under the "Save Sent Item To" selection. Thanks for the help!!
Sub ExampleGenerateSalesEmail()
'Written by Josh Valenti on 10-01-19
'Purpose - Expedite Sales Email Creation
Dim OutDestFolder As Outlook.MAPIFolder
Dim itEmail As Outlook.MailItem
Dim Session As Outlook.Namespace
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim strSignatureFile As String
Dim objFileSystem As Object
Dim objTextStream As Object
Dim strSignature As String
Application.ScreenUpdating = False
StartCell = ActiveCell.Address
'Skipped Defining of FullName, FirstName, CompanyShortName, FileLocation, VersionVal, stRecipient, StBody
Application.DisplayAlerts = False
Set apOutlook = CreateObject("Outlook.Application")
Set Session = apOutlook.GetNamespace("MAPI")
''''''
apOutlook.Session.Logon
Set itEmail = apOutlook.CreateItem(olMailItem)
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
End If
strSignatureFile = "C:\Users\vajo5001\AppData\Roaming\Microsoft\Signatures\SaEM Sign with Opt Out no HC.htm"
'Read the specific signature file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFileSystem.OpenTextFile(strSignatureFile)
strSignature = objTextStream.ReadAll
With itEmail
.HTMLBody = strSignature
.Display
End With
Signature = itEmail.HTMLBody
StBody = "" & StBody
Set OutDestFolder = Session.GetDefaultFolder(olFolderDeletedItems)
With itEmail
.To = stRecipient
.CC = "example.email@example.com"
.Subject = stSubject
.HTMLBody = StBody & & Signature
.Display
.DeferredDeliveryTime = Date + 1 & " 10:45 AM" ' Deliver After 10:45 AM Next Day
Set MailItem.SaveSentMessageFolder = OutDestFolder
End With
End Sub
Last edited:
