CODEWITHSUNDEEP
vbaoutlook
Pradeep Yadav impradeepy
Pradeep Yadav impradeepy

Reputation: 1

How to Save Email from inbox to local drive as .msg file?

Public Sub SaveAttachmentsToDisk()
    Dim oMail As Outlook.MailItem 
    Dim ns As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim SaveFolder As String 
    
    SaveFolder = "D:\Test"
    Set ns = GetNamespace("MAPI")
     
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    For Each oMail in Inbox.Items
        oMail.SaveAs SaveFolder, olMSG
    
End Sub

I want to move emails to the local drive as a .msg file.

Upvotes: 0

Views: 274

Answers (2)

Eugene Astafiev
Eugene Astafiev

Reputation: 49397

The path in which to save the item should include the file name, for example:

Sub SaveAsTXT()
    Dim myItem As Outlook.Inspector
    Dim objItem As Object
    
    Set myItem = Application.ActiveInspector
    
    If Not TypeName(myItem) = "Nothing" Then
        Set objItem = myItem.CurrentItem
        strname = objItem.Subject
        
        'Prompt the user for confirmation
        Dim strPrompt As String
        strPrompt = "Are you sure you want to save the item? " & _
                    "If a file with the same name already exists, " & _
                    "it will be overwritten with this copy of the file."
        
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            objItem.SaveAs Environ("HOMEPATH") & "\My Documents\" & strname & ".txt", olTXT
        End If
        Else
            MsgBox "There is no current active inspector."
    End If
End Sub

Or in your code:

Public Sub SaveAttachmentsToDisk()
    Dim oMail As Outlook.MailItem
    Dim ns As Namespace
    Dim Inbox As Outlook.MAPIFolder
    Dim SaveFolder As String
    
    SaveFolder = "D:\Test"
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    
    For Each oMail In Inbox.Items
        oMail.SaveAs SaveFolder & oMail.Subject & ".msg", olMSG
    Next oMail
End Sub

Upvotes: 1

Алексей Р
Алексей Р

Reputation: 7627

Try this code:

Public Sub SaveAttachmentsToDisk()

    Dim oMail As Outlook.MailItem, ns As NameSpace, Inbox As Outlook.MAPIFolder
    Dim SaveFolder As String, i As Integer
    
    SaveFolder = "D:\Test\"
    
    If Dir(SaveFolder, vbDirectory) = "" Then
        MsgBox "Check the save folder path", vbCritical + vbOKOnly
    Else
        Set ns = GetNamespace("MAPI")
        Set Inbox = ns.GetDefaultFolder(olFolderInbox)
        
        For Each oMail In Inbox.Items
            oMail.SaveAs SaveFolder & "MailItemNo_" & i & ".msg", OlSaveAsType.olMSG
            ' You can use oMail.Subject as a filename instead MailItemNo_, 
            ' but it's need to be removed prohibited characters from it previously 
            ' and control unique of the filename
            i = i + 1
        Next
    End If
End Sub

Upvotes: 0

Related Questions