CODEWITHSUNDEEP
vbaoutlook
Chadi N
Chadi N

Reputation: 441

Save attachments to a new Windows folder?

Every time I receive an email with the subject "Test", I want to:

  1. Automatically extract all attachments and store them in its own new created folder.
  2. Automatically copy the email inside this new folder
  3. Automatically add a Word document inside this new folder.
  4. The folder must be named by the date received.

The code I have copies all attachments in a pre-selected folder, but it doesn't create a personal folder for them.

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item

    'Change variables to match need. Comment or delete any part unnecessary.
        If (Msg.Subject = "Heures") And _
        (Msg.Attachments.Count >= 1) Then

    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim Att As Variant

    Const attPath As String = "C:\Users\NASC02\Test\"

    ' save attachment
    Set myAttachments = item.Attachments
    For Each Att In myAttachments
    Att.SaveAsFile attPath & Att.FileName

Next

    ' mark as read
   Msg.UnRead = False



End If
End If


ProgramExit:
  Exit Sub

ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Upvotes: 1

Views: 127

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66286

The code

Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att

needs to be changed to

Set myAttachments = item.Attachments
for each Att in myAttachments 
    Att.SaveAsFile attPath & Att.FileName
next

Upvotes: 1

Related Questions