Log in

View Full Version : [SOLVED:] Save Sent Item To "other folder" Outlook 2013


goldbeck09
06-05-2015, 08:09 AM
Hi All,

I have a macro that creates an e-mail, but I'd like to make a few minor edits to it, such as changing the "save sent item to" to a folder other than the default "sent items"

I've been trying to use the MailItem.SaveSentMessageFolder property but i could not piece it together. Any advice? Below is my macro if anyone was curious, but the code below does not currently have any progress towards my question.


Sub Email()


Dim OutApp As Object
Dim OutMail As Object
Dim signature As String




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)



On Error Resume Next
With OutMail
.Display
.ReadReceiptRequested = True
End With


signature = OutMail.HTMLBody
With OutMail
.To = "Invoices"
.CC = ""
.BCC = ""
.Subject = "Some text " & Format(Date, "mm/dd/yyyy")
'.HTMLBody = "<p style='font-family:arial narrow;font-size:14.5'>" & "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed (In-House) by project." & "</p>" & signature
.HTMLBody = "<p style='font-family:arial;font-size:10pt;color:#003366 '>" & "Team - Corp Group" & "<br>" & "<br>" & _
"Please code the (s) for , and forward to AP for processing." & "<br>" & "<br>" & _
"Let me know if additional support is needed." & "</p>" & signature


'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'or use .Display
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing





End Sub
skatonni
06-05-2015, 10:11 AM
Option Explicit

Sub Email()

'Dim OutApp As Object ' <--- When code is not in Outlook
'Dim OutMail As Object ' <--- When code is not in Outlook

Dim OutMail As MailItem

Dim signature As String

Dim otherSaveSentMailFolder As Folder

'Set OutApp = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItem(0)

' **** If code is in Outlook *****
Set OutMail = Application.CreateItem(0)
' or simply
'Set OutMail = CreateItem(0)

'On Error Resume Next ' <--- Do not use unless there is a reason.
' If there is a reason for use then follow as soon as possible with On Error GoTo 0

signature = OutMail.HTMLBody

'Set otherSaveSentMailFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("subfolder of Inbox")
'or
Set otherSaveSentMailFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("subfolder of Inbox")

With OutMail
.To = "Invoices"
.CC = ""
.BCC = ""
.Subject = "Some text " & Format(Date, "mm/dd/yyyy")
'.HTMLBody = "<p style='font-family:arial narrow;font-size:14.5'>" & "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed (In-House) by project." & "</p>" & signature
.HTMLBody = "<p style='font-family:arial;font-size:10pt;color:#003366 '>" & "Team - Corp Group" & "<br>" & "<br>" & _
"Please code the (s) for , and forward to AP for processing." & "<br>" & "<br>" & _
"Let me know if additional support is needed." & "</p>" & signature

.ReadReceiptRequested = True

Set .SaveSentMessageFolder = otherSaveSentMailFolder
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")

'.Send
'or use
.Display

End With

'On Error GoTo 0 '<--- This could be considered a bug in the code.
' It is far from On Error Resume Next

Set OutMail = Nothing
' Set OutApp = Nothing

End Sub
goldbeck09
06-05-2015, 11:25 AM
This looks like the right direction, but the code errors on line
Set xFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("R12")

Run-time error '-2147221233 (8004010f) The attmpted operation failed. An object could not be found.



Sub WNS_INVOICES()


'Dim OutApp As Object
'Dim OutMail As Object


Dim Outmail As MailItem
Dim Signature As String
Dim xFolder As Folder


'Set OutApp = CreateObject("Outlook.Application")
'Set Outmail = OutApp.CreateItem(0)


Set Outmail = Application.CreateItem(0)


'On Error Resume Next


Signature = Outmail.HTMLBody
Set xFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("R12")


With Outmail
.To = "WNS Invoices"
.CC = ""
.BCC = ""
.Subject = "CES Corp Group Invoice " & Format(Date, "mm/dd/yyyy")
'.HTMLBody = "<p style='font-family:arial narrow;font-size:14.5'>" & "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed Capitalized Software (In-House) recap by project." & "</p>" & signature
.HTMLBody = "<p style='font-family:arial;font-size:10pt;color:#003366 '>" & "WNS Team - CES Corp Group" & "<br>" & "<br>" & _
"Please code the invoice(s) for CES Corp Group, and forward to AP for processing." & "<br>" & "<br>" & _
"Let me know if additional support is needed." & "</p>" & Signature


.ReadReceiptRequested = True
Set .SaveSentMessageFolder = xFolder


'.HTMLBody = "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed Capitalized Software (In-House) recap by project." _
'& vbNewLine & Signature


' .HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"




'.Attachments.Add ActiveWorkbook.FullName


'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'or use .Display


.Display


End With
On Error GoTo 0


Set Outmail = Nothing
'Set OutApp = Nothing


End Sub

thank you so much.
skatonni
06-05-2015, 12:37 PM
Perhaps the folder is deeper and you did not specify all folders in the chain?


xFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Subfolder of Inbox").Folders("subfolder of the Subfolder of Inbox").Folders("R12")
goldbeck09
06-05-2015, 01:20 PM
That is exactly it...wow.. im impressed. So, that enabled the correct folder to save to...but could you help me adjust the code to have it include my outlook siganature? The newly adjusted code now doesn't bring in my signature line at the bottom.


Signature = Outmail.HTMLBody



Sub WNS_INVOICES()


'Dim OutApp As Object
'Dim Outmail As Object


Dim Outmail As MailItem
Dim Signature As String
Dim xFolder As Folder


'Set OutApp = CreateObject("Outlook.Application")
'Set Outmail = OutApp.CreateItem(0)


Set Outmail = Application.CreateItem(0)


'On Error Resume Next
On Error GoTo 0


Signature = Outmail.HTMLBody
Set xFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Corporate Accounting").Folders("Fixed Assets").Folders("Invoice(s) sent to WNS")






With Outmail
.To = "WNS Invoices"
.CC = ""
.BCC = ""
.Subject = "CES Corp Group Invoice " & Format(Date, "mm/dd/yyyy")
'.HTMLBody = "<p style='font-family:arial narrow;font-size:14.5'>" & "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed Capitalized Software (In-House) recap by project." & "</p>" & signature
.HTMLBody = "<p style='font-family:arial;font-size:10pt;color:#003366 '>" & "WNS Team - CES Corp Group" & "<br>" & "<br>" & _
"Please code the invoice(s) for CES Corp Group, and forward to AP for processing." & "<br>" & "<br>" & _
"Let me know if additional support is needed." & "</p>" & Signature


.ReadReceiptRequested = True
Set .SaveSentMessageFolder = xFolder


'.HTMLBody = "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed Capitalized Software (In-House) recap by project." _
'& vbNewLine & Signature


' .HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"




'.Attachments.Add ActiveWorkbook.FullName


'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'or use .Display


.Display
End With
On Error GoTo 0


Set Outmail = Nothing
'Set OutApp = Nothing


End Sub
skatonni
06-05-2015, 01:54 PM
I have seen it before but the reason for this is not in my knowledge. It can be slower, but in this case Display first not last.



Sub WNS_INVOICES()

Dim OutMail As MailItem
Dim signature As String
Dim xFolder As Folder

Set OutMail = Application.CreateItem(0)
With OutMail
.Display
signature = .HTMLBody
End With

Set xFolder = Application.Session.GetDefaultFolder(olFolderInbox) _
.Folders("Corporate Accounting").Folders("Fixed Assets") _
.Folders("Invoice(s) sent to WNS")

With OutMail
.To = "WNS Invoices"
.CC = ""
.BCC = ""
.Subject = "CES Corp Group Invoice " & Format(Date, "mm/dd/yyyy")
'.HTMLBody = "<p style='font-family:arial narrow;font-size:14.5'>" & "Team," & "<br>" & "<br>" & _
'"Please see the attached report for the Internally Developed Capitalized Software (In-House) recap by project." & "</p>" & signature
.HTMLBody = "<p style='font-family:arial;font-size:10pt;color:#003366 '>" & "WNS Team - CES Corp Group" & "<br>" & "<br>" & _
"Please code the invoice(s) for CES Corp Group, and forward to AP for processing." & "<br>" & "<br>" & _
"Let me know if additional support is needed." & "</p>" & signature

.ReadReceiptRequested = True
Set .SaveSentMessageFolder = xFolder

End With

Set OutMail = Nothing
Set xFolder = Nothing

End Sub
goldbeck09
06-05-2015, 02:04 PM
Everything works! Thank you so much. This was really giving me a headache..i looked through 5 pages on google searches... All my searches involved 50 lines of code, and I knew mine wouldn't be that complex. Thank you for helping me out.

Solved!