How to copy a email attached to a specific folder ?

Public Sub CopyAttachment(msg As MailItem)

    Dim id As String
    Dim ns As Outlook.NameSpace
    Dim m As Outlook.MailItem
    Dim fileName As String
    Dim attach As Outlook.Attachment
    Dim i As Integer
    
    Const path = "C:\Email Attachments\"
    
    id = msg.EntryID
    Set ns = Application.GetNamespace("MAPI")
    Set m = ns.GetItemFromID(id)
    
    For Each attach In m.Attachments
            fileName = path & Strings.Format(DateTime.Now, "MM-dd-yy_hhmmss") & "_" & _
                Strings.Format(i) & "_" & attach.fileName
            attach.SaveAsFile fileName
            i = i + 1
            m.UnRead = False
    Next attach
    
    'Clean Up
    Set ns = Nothing
    Set m = Nothing
    Set attach = Nothing

End Sub

Select all Open in new window