📜  从 vba 中的电子邮件附件获取 excel 文件(1)

📅  最后修改于: 2023-12-03 15:06:32.730000             🧑  作者: Mango

从 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 文件中的程序。其他的邮件附件或附件类型可以通过简单的修改代码来获取和处理。