Need help creating a VBA code that extracts attachments with subfolders per email

Question

I'm trying to create a code that does this:

Public Sub saveAttachment(item As Outlook.MailItem)
Dim attachment As Outlook.Attachment
Dim defaultPath As String
defaultPath = "c:\Email Exports"
     For Each attachment In itm.Attachments
          attachment.SaveAsFile defaultPath & "\" & attachment.DisplayName
          Set attachment = Nothing
     Next
End Sub

...while also being able to create subfolders per email it extracts from

Ex. John Doe - Important files has 2 attachments. VBA Code would create a John Doe - Important files folder and add the 2 attachments inside.

The default behavior would be to save them as individual files but I would like them instead to be organized per email. I have stumbled on ways to do the creation part, but it always creates a folder per attachment and not per email. I'm not sure where or how to add a createFolder for this to work in my favor.

Is this possible to do in VBA?

score 0 · Accepted Answer · answered Aug 18 '21 at 21:25

0

It seems you need to check attachments number before creating a folder and iterating over all attachments.

Public Sub saveAttachment(item As Outlook.MailItem)
Dim attachment As Outlook.Attachment
Dim defaultPath As String
defaultPath = "c:\Email Exports"

  If itm.Attachments.Count > 0 Then
     Dim yourPath as String = MkDir "Ex. John Doe - Important files", defaultPath
     For Each attachment In itm.Attachments
          attachment.SaveAsFile yourPath "\" & attachment.DisplayName
          Set attachment = Nothing
     Next
  End If 
End Sub

You need to check if the folder exists. If not, then make it. This function does the job.

'requires reference to Microsoft Scripting Runtime
Function MkDir(strDir As String, strPath As String) as String

Dim fso As New FileSystemObject
Dim path As String

'examples for what are the input arguments
'strDir = "Folder"
'strPath = "C:\"

path = strPath & strDir

If Not fso.FolderExists(path) Then

' doesn't exist, so create the folder
          fso.CreateFolder path

End If

Return path

End Function

See How do I use FileSystemObject in VBA? for more information.

answered Aug 18 '21 at 21:25

Eugene Astafiev

34,483
3
16
35

So just to verify. Could I also do something like MkDir(item.SenderName & " - " & item.Subject, defaultPath) And would this create a folder as "John Doe - Important Files" if the sender name is "John Doe" and subject is "Important Files"? – Droid Rahl Carreon Aug 18 '21 at 21:55
Yes, you can. But need to make sure special characters are not used in the file path string. – Eugene Astafiev Aug 18 '21 at 22:05
Would it be safer to just use the filename then? Since filenames are already free of special characters that you can't use for folders anyways? Oh, but I won't be able to create that since the MkDir is above the attachment For Each... – Droid Rahl Carreon Aug 18 '21 at 22:09
it is up to you which data is to use, but I'd recommend checking for the special characters in the code by using the [Replace](https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/replace-function) function. – Eugene Astafiev Aug 18 '21 at 22:12

Need help creating a VBA code that extracts attachments with subfolders per email

1 Answers1