📅  最后修改于: 2023-12-03 15:06:32.730000             🧑  作者: Mango
在 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 库。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 文件所在的文件夹中:
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 文件中的程序。其他的邮件附件或附件类型可以通过简单的修改代码来获取和处理。