How to save mails created by macro in a folder drive (not in outlook)

[ThrottleWorks]

Hi,

I do not know if it is possible.

I am trying to create e-mails by using Ron De Bruin’s code. Usually created emails are saved as draft in Outlook only.

Is it possible to save created e-mails at a folder (drive).
Just as we manually use ‘Save as’ option to save draft at folder, is it possible by coding also.

Can anyone please help me in this.

 

[Logit]

This macro creates an email .. displays it for review prior to sending .. saves a PDF copy of the email content to the desktop :

Option Explicit

Sub Mail_workbook_Outlook()

    Dim OutApp As Object
    Dim OutMail As Object
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "logitga@yahoo.com "
        .CC = ""
        .BCC = ""
        .Subject = "Test"
        .Body = ""
        .Attachments.Add (Application.ActiveWorkbook.FullName)
     
        '.Send
        .display
    End With
 
    Sheets("Save PDF").Range("A1").Value = OutMail.To
    Sheets("Save PDF").Range("A2").Value = OutMail.CC
    Sheets("Save PDF").Range("A3").Value = OutMail.BCC
    Sheets("Save PDF").Range("A4").Value = OutMail.Subject
    Sheets("Save PDF").Range("A5").Value = OutMail.Body
 
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
 
    SaveAsPDF
 
End Sub

Private Sub Application_Startup()
    Dim objSent As Outlook.MAPIFolder
    Set objNS = Application.GetNamespace("MAPI")
    Set objSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
    Set objNS = Nothing
End Sub

Sub SaveAsPDF()
Dim fName As String
With Worksheets("Save PDF")
    fName = .Range("A1").Value
End With
Sheets("Save PDF").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\My\Desktop\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         
Sheets("Save PDF").UsedRange.ClearContents

End Sub

 

[Chihiro]

Not sure which code you are using. But you can use MailItem.SaveAs method.
https://msdn.microsoft.com/en-us/library/office/ff868727.aspx

NOTE: In some instances, if MailItem is saved as *.msg Outlook has trouble opening the file. There's various causes and I was unable to locate definitive solution to this issue. If you just want to save the contents. Just save as html. It will retain all info in an email. But will not have attachment (just file name).

 

[ThrottleWorks]

Hi @Logit sir, thanks for the help. Have a nice day ahead.

Hi @Chihiro sir, thanks for the help. I forgot to add, we have attachment too. My bad. For the time being, we are saving drafts in Outlook only.

Have a nice day ahead.

 

[Logit]

You are welcome. Glad to help. Thank you.

 

[SB420]

This macro creates an email .. displays it for review prior to sending .. saves a PDF copy of the email content to the desktop :

Option Explicit

Sub Mail_workbook_Outlook()

    Dim OutApp As Object
    Dim OutMail As Object
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "logitga@yahoo.com "
        .CC = ""
        .BCC = ""
        .Subject = "Test"
        .Body = ""
        .Attachments.Add (Application.ActiveWorkbook.FullName)
    
        '.Send
        .display
    End With
 
    Sheets("Save PDF").Range("A1").Value = OutMail.To
    Sheets("Save PDF").Range("A2").Value = OutMail.CC
    Sheets("Save PDF").Range("A3").Value = OutMail.BCC
    Sheets("Save PDF").Range("A4").Value = OutMail.Subject
    Sheets("Save PDF").Range("A5").Value = OutMail.Body
 
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
 
    SaveAsPDF
 
End Sub

Private Sub Application_Startup()
    Dim objSent As Outlook.MAPIFolder
    Set objNS = Application.GetNamespace("MAPI")
    Set objSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
    Set objNS = Nothing
End Sub

Sub SaveAsPDF()
Dim fName As String
With Worksheets("Save PDF")
    fName = .Range("A1").Value
End With
Sheets("Save PDF").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\My\Desktop\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        
Sheets("Save PDF").UsedRange.ClearContents

End Sub

Please help me...I need my email drafts to be saved to a SHARED Outlook mailbox draft folder...NOT my personal Outlook Draft folder...is this possible? Can you write me a macros to do so, like you did above??

 

[vletm]

SB420​

This, about six years old thread is closed now.