Sub GetAttachments()
'If an error occurs, such as the target or destination folder
'don't exist, then go to the "GetAttachments_err" tag
On Error GoTo GetAttachments_err
'Create (dimensionate) the variables we're using,
'including the ones we use in the cycles
'This is the variable that will hold the folder we want to process
Dim folder As MAPIFolder
'This is a generic variable that will be used in Cycle(1),
'and will hold a reference to the current item in a folder
'being evaluated. It is an object because a folder item
'could be a mail message, a folder, or several other item types
Dim item As Object
'This is the variable that will hold a reference to each attachment
'we'll process, and has the methods for saving it
Dim attachment As attachment
'This is a variable that will have the full path for the saved file,
'and will be used to save the attachment
Dim fileName As String
'This is only a counter that will count how many attachments
'were processed (saved)
Dim attachmentCount As Integer
'I've separated the following variables, because it's easier
'to understand them like this.
'You could declare them with the rest without problem
'This variable will be used to process the target folder
'in Outlook's tree structure.
Dim folderPath As String
'The user will enter a full path (without "Personal Folders"
'at the beginning), and the macro will automatically
'reference the corresponding object.
'This instruction shows a dialog box where the user must enter
'the target folder path, using "\" as a separator
folderPath = InputBox("Please enter the target folder path, using '\' as a separator", "Please choose the folder to process")
'This variable is used together with slashPosition to divide
'folderPath and reach the target folder
Dim start As Integer
start = 1 'In VBA collections start from 1, not from 0 as in C#
'This variable is used together with slashPosition to divide
'folderPath and reach the target folder
Dim slashPosition As Integer
'We now use the InStr function, which receives the start position
'(optional), a source string, a string to look for
'in the first string, and a comparison method, binary, directory or text.
'We use the last one
slashPosition = InStr(start, folderPath, "\", vbTextCompare)
'Session is the object that corresponds to the current user session.
'It has a Folders collection, where you have the
'root folders, such as "Personal Folders".
'The first one (remember that collections start in 1) is Personal Folders.
Set folder = Session.Folders.item(1)
'This will help us to get the reference to the specified folder
'in the hierarchy
While slashPosition > 0 '"while there are more slashes in the string
'The folders collection can be accessed by folder name.
'What we do here is set same folder option as it's child,
'by accessing the folders collection using the result of the
'Mid function call. This function receives a string,
'a start position and an amount of characters,
'and returns the sub-string
Set folder = folder.Folders(Mid(folderPath, start, slashPosition - start))
'After we assigned the folder object,
'we set the variables that control the cycle
'This "If" is used to check if the text entered by the user
'ends with "\"
If (slashPosition < Len(folderPath)) Then
' The start position is the character next to the "\"
start = slashPosition + 1
slashPosition = InStr(start, folderPath, "\", vbTextCompare)
End If
Wend
'After we processed the string, we set the folder to the last item
'of the hierarchy.
'If there were no slashes on the text entered by the user,
'then this is the only instruction executed; the cycle is not used
'We subtract 1 from "start" because "collections in VBA start in 1"
'(believe it or not, this was one of my headaches when writing this macro)
Set folder = folder.Folders(Mid(folderPath, start, Len(folderPath) - (start - 1)))
'We set the attachment count in 0
attachmentCount = 0
'If there are no subitems in the selected folder,
'then the macro shows a message and exits
If folder.Items.Count = 0 Then
MsgBox "There are no messages in the selected folder, so no attachment will be saved.", vbInformation, "Done"
Exit Sub
End If
'This variable holds the path to the folder where the attachments
'will be saved
Dim saveFolderPath As String
'We use the same method as above,
'"InputBox", with an extra (optional) parameter, "DefaultValue"
saveFolderPath = InputBox("Enter the destination path", "Choose a destination path that was cerated beforehand", "c:\tmp")
'Cycle(1)
For Each item In folder.Items 'For each item in the folder
For Each attachment In item.Attachments
'Every item, disregarding it's type, has the attachment collection
'We set the file name for this attachment using the path chosen by
'the user and the filename of the attachment
fileName = saveFolderPath + "\" & attachment.fileName
'We call the "SaveAsFile" method of the attachment object
'and pass "filename" as a parameter to save it to
'the desired location
attachment.SaveAsFile fileName
'We increment the attachment count variable
attachmentCount = attachmentCount + 1
Next attachment
Next item
'If at least one attachemt was saved, we show the user how many and
'where they were saved
If attachmentCount = 1 Then
MsgBox attachmentCount & " attachments was found." _
& vbCrLf & "They were saved in " + saveFolderPath + ".", _
vbInformation, "Done!"
Else
If attachmentCount > 1 Then
MsgBox attachmentCount & " attachments were found." _
& vbCrLf & "They were saved in " + saveFolderPath + ".", _
vbInformation, "Done!"
Else
MsgBox "No attachment was found.", vbInformation, "Done!"
End If
End If
'We dispose the objects we used by setting them null
GetAttachments_exit:
Set attachment = Nothing
Set item = Nothing
Exit Sub
'If there is any error, this code section is executed, after which
'the objects are disposed by resuming execution at
'"GetAttachments_exit"
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub | 
Posts
