Save Outlook Attachments to File system

Question

I am trying to save attachments from emails in my inbox or a subfolder, to the file system.

I am trying to assign a button to the code in Outlook's default VBA: Module1

Variation 1 doesn't let me create a macro since I have MItem As Outlook.MailItem in the Sub definition.

Public Sub SaveAtt(MItem As Outlook.MailItem)
    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    
    ' Set the folder where attachments will be saved
    sSaveFolder = "C:\Temp\junk\Move"  ' Change this path to your desired folder
    
    For Each oAttachment In MItem.Attachments
        oAttachment.SaveAsFile sSaveFolder & oAttachment.FileName
    Next oAttachment
End Sub

I removed that variable passed into the subroutine, but then I get:

Object variable or with block not set.

The intent was to select an individual mailbox item in my inbox then click the macro button. I'm not sure if that is possible.
My next thought is to move all the interesting mailbox items to a subfolder of the inbox and running the routine once (from a macro launch button) on all messages in this folder.

I found another piece of code, which also looks like it may work, but it doesn't.

Public Sub SaveAtt()

    Dim MItem As MailItem
    Dim oAttachment As Attachment
    Dim sSaveFolder As String
    Dim oDefInbox As Folder
    Dim targetFolder As Folder
    Dim myItems As Outlook.Items
    Dim Item As Object

    Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)
    'Set targetFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Inbox")

    sSaveFolder = "C:\Temp\junk\Move"
    
    For Each MItem In oDefInbox.Items
        For Each oAttachment In MItem.Attachments
            oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
            Set oAttachment = Nothing
        Next oAttachment
    Next MItem

End Sub

Answer 1

I coded two choices, one which saves from the MAPI inbox folder structure, and one which saves from an Outlook "archive" or .PST folder structure.

Sub OSAtt()
  
    'Misc String variables
    Dim sAppver as string : sAppver = "OSAtt v0.3"
    Dim sSaveAttName As String
    Dim sSaveAttDate As String
    Dim sSaveAttDay As String
    Dim sSaveAttMonth As String
    Dim sSaveAttYear As String
    
    'Counters used in messaging
    Dim iMsgCount As Integer: iMcnt = 0 'var to count total messages processed
    Dim iSaveCount As Integer: iScnt = 0 'var to count total new attachments saved

    'Subfolder within outlook inbox
    Dim sMSG_FOLDER_OTLK As String 'textual name of Outlook folder
    sMSG_FOLDER_OTLK = "_ConfigDiffs"
    'Continue Dialog Box
    answer = vbYes
    answer = MsgBox("Process attachements in" & vbCR & _
    "Outlook subfolder?: " & sMSG_FOLDER_OTLK, _
    vbYesNo, "Outlook Save Attach - " & sAppver)
    If answer = vbNo Then Exit Sub
    
    'Set the folder where attachments will be saved
    Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim sSaveFolder As String
    'sSaveFolder = "C:\Temp\junk\"
    
    'Verify the folder path for saving actually exists
    If Not FSO.FolderExists(sSaveFolder) Then
        MsgBox "Save folder location appears to be invalid. Please verify:" & vbCR & sSaveFolder
        Exit Sub
    End If

    'Set up Outlook Folder/namespace items
    Dim MItem As Outlook.MailItem
    Dim oAttachment As Outlook.Attachment
    Dim MSG_FOLDER As Outlook.Folder

    'Choice1: a folder in the existing MAPI session...
    'if multi-level subfolder, insert '.Folders(<RootFolderName>)' Folders(sMSG_FOLDER_OTLK)
    'Set MSG_FOLDER = Session.GetDefaultFolder(olFolderInbox).Folders(sMSG_FOLDER_OTLK)
    
    'Choice2: a folder in an archive MAPI folder set...
    'if multi-level subfolder, insert '.Folders(<RootFolderName>)' Folders(sMSG_FOLDER_OTLK)
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.Session
    Set MSG_FOLDER = olNs.Folders("my_archive").Folders(sMSG_FOLDER_OTLK)

    'MsgBox MSG_FOLDER.Name '4Dbg
    'MsgBox MSG_FOLDER.FolderPath '4Dbg
    'MsgBox MSG_FOLDER.Store.DisplayName '4Dbg

    'Process each message in the specified folder
    For Each MItem In MSG_FOLDER.Items
        'MsgBox "Processing Message from: " & vbCr & Str(MItem.ReceivedTime) '4Dbg
        
        For Each oAttachment In MItem.Attachments
        
            'Construct the Prepended Date string for the filename
            sSaveAttDate = Split(Str(MItem.ReceivedTime), " ")(0)
            sSaveAttDay = Split(sSaveAttDate, "/")(1)
            If Len(sSaveAttDay) = 1 Then sSaveAttDay = "0" & sSaveAttDay
            sSaveAttMonth = Split(sSaveAttDate, "/")(0)
            If Len(sSaveAttMonth) = 1 Then sSaveAttMonth = "0" & sSaveAttMonth
            sSaveAttYear = Split(sSaveAttDate, "/")(2)
            
            'Save the attachement to the file system
            sSaveAttName = sSaveAttYear & sSaveAttMonth & sSaveAttDay & "_" & oAttachment.FileName
            'MsgBox sSaveAttName  '4Dbg
            
            If Not FSO.FileExists(sSaveFolder & sSaveAttName) Then
                oAttachment.SaveAsFile sSaveFolder & sSaveAttName
                iScnt = iScnt + 1 ' increment saved attachment count by one
                Set oAttachment = Nothing
            End If
            
        Next oAttachment
        iMcnt = iMcnt + 1 ' increment message count by one
        
    Next MItem
    MsgBox "Processed " & iMcnt & " Messages" & vbCR & "Saved " & iScnt & " new attachements", , "Outlook Save Attach - " & sAppver

End Sub

Answer 2

In your first code snippet, you never initialize the MItem variable. If your intention is to processes selected items rather than all items in the Inbox, change the line

For Each MItem In oDefInbox.Items

to

For Each MItem In Application.ActiveExplorer.Selection

Also, your sSaveFolder variable must include the trailing "\"