从 VBA 中的电子邮件附件获取 Excel 文件

在 VBA 中，我们可以编写代码来读取电子邮件附件，将信息提取到 Excel 文件或数据库中。本篇文章将演示如何从 VBA 中的电子邮件附件获取 Excel 文件。

需求分析

一个常见的需求是从邮件附件中获取 Excel 文件，并将它们拼接到一个 Excel 文件中。以下是我们需要设定和实现的步骤：

设定目标文件夹

首先需要设定我们要保存附件的目标文件夹。这里我们可以创建一个新的文件夹，或使用现有的文件夹。下面是示例代码，设定一个目标文件夹 C:\Attachments\：

Sub SetTargetFolder()

    ' Set target folder
    Dim targetPath As String
    targetPath = "C:\Attachments\"
    
    ' Create target folder if it does not exist
    If Dir(targetPath, vbDirectory) = "" Then
        MkDir targetPath
    End If
    
End Sub

导入 Outlook 库

要使用电子邮件功能，需要导入 Outlook 库。VBA 代码中可以通过下面一行实现：

    ' Import Outlook library
    Private WithEvents outlookApp As Outlook.Application

获取所有未读邮件

我们需要编写代码来获取所有未读邮件。以下是示例代码，获取邮箱中所有未读邮件：

Sub GetUnreadEmails()

    ' Get all unread emails
    Dim outlookApp As New Outlook.Application
    Dim outlookNamespace As Outlook.Namespace
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    Dim inboxFolder As Outlook.MAPIFolder
    Set inboxFolder = outlookNamespace.GetDefaultFolder(olFolderInbox)
    Dim items As Outlook.Items
    Set items = inboxFolder.Items
    
    ' Filter unread emails
    items.Restrict ("[Unread] = true")
    
    ' Loop through emails
    Dim email As Outlook.MailItem
    For Each email In items
        ' Process email attachments here
    Next email
    
End Sub

请注意，我们需要从 Outlook 库中导入对象 Outlook.Application，并转换为 New Outlook.Application。这里我们通过 outlookNamespace 对象获取默认收件箱 inboxFolder，并过滤只需要未读邮件。最后，我们循环遍历未读邮件的 items，处理邮件附件。

提取电子邮件附件

循环遍历所有未读邮件后，需要提取每条邮件的附件。以下是示例代码，将邮件附件保存到目标文件夹 C:\Attachments\ 中：

Sub SaveAttachments()

    ' Set target folder
    Dim targetPath As String
    targetPath = "C:\Attachments\"
    
    ' Get all unread emails
    Dim outlookApp As New Outlook.Application
    Dim outlookNamespace As Outlook.Namespace
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    Dim inboxFolder As Outlook.MAPIFolder
    Set inboxFolder = outlookNamespace.GetDefaultFolder(olFolderInbox)
    Dim items As Outlook.Items
    Set items = inboxFolder.Items
    items.Restrict ("[Unread] = true")
    
    ' Loop through emails
    Dim email As Outlook.MailItem
    For Each email In items
        ' Loop through attachments
        Dim attachment As Outlook.Attachment
        For Each attachment In email.Attachments
            ' Only process Excel files
            If Right(attachment.FileName, 4) = "xlsx" Or Right(attachment.FileName, 3) = "xls" Then
                
                ' Save attachment to target folder
                Dim saveFilePath As String
                saveFilePath = targetPath & attachment.FileName
                attachment.SaveAsFile saveFilePath
                
                ' Code to process saved attachment goes here
                
            End If
        Next attachment
    Next email
    
End Sub

将 Excel 文件拼接到一个文件中

最后，我们需要将保存到目标文件夹中的 Excel 文件拼接到一个文件中。以下是示例代码，将每个 Excel 文件的第一个工作表复制到新的 Excel 文件中，保存在源 Excel 文件所在的文件夹中：

Sub CombineExcelFiles()

    ' Set source and target folders
    Dim sourcePath As String
    sourcePath = "C:\Attachments\"
    Dim targetPath As String
    targetPath = "C:\Attachments\Combined\"
    
    ' Create target folder if it does not exist
    If Dir(targetPath, vbDirectory) = "" Then
        MkDir targetPath
    End If
    
    ' Loop through Excel files in source folder
    Dim excelFilePath As String
    Dim excelWorkbook As Workbook
    excelFilePath = Dir(sourcePath & "*.xls*")
    Do While excelFilePath <> ""
        
        ' Open Excel file
        Set excelWorkbook = Application.Workbooks.Open(sourcePath & excelFilePath)
        
        ' Copy first sheet to target workbook
        Dim targetWorkbook As Workbook
        Set targetWorkbook = Application.Workbooks.Add
        excelWorkbook.Worksheets(1).Copy Before:=targetWorkbook.Worksheets(1)
        
        ' Save target workbook
        targetWorkbook.SaveAs targetPath & "Combined_" & excelFilePath
        
        ' Close Excel file
        excelWorkbook.Close False
        
        ' Get next Excel file in source folder
        excelFilePath = Dir()
    Loop
    
End Sub

此程序会在指定的 sourcePath 目录中查找并循环遍历 Excel 文件（也可以根据需要修改搜索条件），每个 Excel 文件的第一个工作表将被复制到新的 Excel 文件中，并保存在指定的 targetPath 目录中（如果不存在，程序会在运行前创建该文件夹）。

总结

通过上述步骤，我们可以编写出一个从 VBA 中的电子邮件附件获取 Excel 文件，将这些 Excel 文件拼接到一个新 Excel 文件中的程序。其他的邮件附件或附件类型可以通过简单的修改代码来获取和处理。