Outlook 附件提取器

引言

你有没有尝试过从 Outlook 中的多条消息中下载附件？

背景

我的 Outlook 中有很多消息，个人邮件、工作邮件、有趣的邮件等等。我想开始整理我的消息，其中一件事就是提取给定文件夹中的所有附件并保存到指定位置，以减小 Outlook 数据文件的大小。我可以选择一条消息，然后转到“文件”->“保存附件”，就完成了。但是，选择多条消息会禁用此菜单项？

这种方法可能不是最好的（实际上也不是），在托管代码中有很多更好的方法可以实现。但是，我正在运行 Windows Vista x64 和 Office 2007，Visual Studio（带有 Vista 的 SP1）仍然无法很好地与这些配合使用，所以我编写了一个 VBA 宏，如果你想要一个快速解决方案，它会很有帮助。

使用代码

由于 VBA 中没有类、对象或类似的东西（不要让我开始说这个，我们只是说没有），我将复制粘贴宏并注释大部分行，以便你知道要编辑哪些内容才能使此宏适应你的需求。

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("Ingrese el path de la carpeta de destino", _
                "Elija la carpeta de destino", "E:\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 

关注点

你可以通过多种方式自定义此宏，例如将消息的日期和时间设置为文件名的一部分，或者仅下载 JPG 文件等文件类型，但本文旨在用作解决日常（好吧，也许一周一次）问题的快速解决方案。

也就是说，如果你需要任何代码定制方面的帮助，请随时与我联系。

历史

• 2007年6月11日：第一个版本