VBA for Outlook - Automate all your email tasks

Open message file

Sub OpenMsgFile()

    Dim olApp As Object
    Dim olMsg As Object   

    'Create Outlook Application object
    Set olApp = CreateObject("Outlook.Application")    

    'Open .msg file
    Set olMsg = olApp.CreateItemFromTemplate("C:\Users\username\Downloads\test.msg")    

    'Display the message
    olMsg.Display    

    'Clean up
    Set olMsg = Nothing
    Set olApp = Nothing    

End Sub

---

Save Email Attachments

Sub SaveEmailAttachments()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim savePath As String
    Dim fileName As String
    Dim i As Long
    
    ' Set folder path where you want to save attachments
    savePath = "C:\Users\username\Downloads\test\"
    
    ' Ensure path ends with backslash
    If Right(savePath, 1) <> "\" Then savePath = savePath & "\"
    
    'Create Outlook objects
    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' Select folder (e.g., Inbox)
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    
    'Loop through each mail item in the folder
    For Each olItem In olFolder.Items
        'Check if it's a mail item
        If TypeName(olItem) = "MailItem" Then
            'Check if it has attachments
            If olItem.Attachments.Count > 0 Then
                For i = 1 To olItem.Attachments.Count
                    Set olAttachment = olItem.Attachments(i)
                    fileName = olAttachment.fileName
                    
                    ' Save attachment
                    olAttachment.SaveAsFile savePath & fileName
                Next i
            End If
        End If
    Next olItem
    
    MsgBox "Attachments saved to: " & savePath, vbInformation
End Sub