Outlook VBA保存邮件附件，然后将附件数据复制到另一个Excel中，并通过邮件发送发送Excel

我试图创build一个Outlook VBA代码来保存从一个特定的邮件到一个文件夹的附件，然后复制粘贴从另一个Excel中的附件中的数据。然后邮件第二个Excel的一些ID。

我创build了一条规则，将传入的自动邮件移动到特定的邮件文件夹，然后将其附件保存到桌面文件夹。保存附件后，数据被复制到第二个Excel文件夹中。 代码是这样的

Public Sub ExportFile(MyMail As MailItem) Dim outNS As Outlook.NameSpace Dim outFolder As Outlook.MAPIFolder Dim outNewMail As Outlook.MailItem Dim strDir As String Set outNS = GetNamespace("MAPI") Set outFolder = outNS.GetDefaultFolder(olFolderInbox).Folders("Network Critical Report") Set outNewMail = outFolder.Items.GetLast strDir = "C:\Users\soumyajitd\Desktop\December\Network Critical Report\" If outNewMail.Attachments.count = 0 Then GoTo Err outNewMail.Attachments(1).SaveAsFile strDir & "Network_Critical_Report.csv" Dim xlApp As Excel.Application Dim wbTarget As Excel.Workbook 'workbook where the data is to be pasted Dim wsTarget As Excel.Worksheet Dim wbThis As Excel.Workbook 'workbook from where the data is to copied Dim wsThis As Excel.Worksheet Dim strName As String 'name of the source sheet/ target workbook Set xlApp = New Excel.Application xlApp.DisplayAlerts = False 'xlApp.Workbooks.Open strDir & "Network_Critical_Report.csv" 'xlApp.Workbooks.Open strDir & "Test.xlsx" Set wbThis = xlApp.Workbooks.Open("C:\Users\soumyajitd\Desktop\December\Network Critical Report\Network_Critical_Report.csv") Set wsThis = wbThis.Worksheets("Network_Critical_Report") Set wbTarget = xlApp.Workbooks.Open("C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx") Set wsTarget = wbTarget.Worksheets("Raw_Data") 'select cell A1 on the target book 'clear existing values form target book wsTarget.UsedRange.ClearContents 'activate the source book wbThis.Activate xlApp.CutCopyMode = False 'copy the range from source book wsThis.UsedRange.Copy 'paste the data on the target book wsTarget.Range("A1").PasteSpecial Paste:=xlPasteValues 'save the target book wbTarget.Save 'close the workbook wbTarget.Close wbThis.Close xlApp.CutCopyMode = False Kill ("C:\Users\soumyajitd\Desktop\December\Network Critical Report\Network_Critical_Report.csv") 'clear memory Set wbTarget = Nothing Set wbThis = Nothing Set xlApp = Nothing Set outNewMail = Nothing Set outFolder = Nothing Set outNS = Nothing Err: Set outFolder = Nothing Set OuNewMail = Nothing Set outNS = Nothing End Sub 

第二个代码是发送一个新的电子邮件与“Test.xlsx”作为附件。它是这样的：

 Sub SendNew(Item As Outlook.MailItem) Dim objMsg As MailItem Dim ToRecipient As Variant Dim ccRecipient As Variant Dim Subject As String Dim Body As String Dim FilePathtoAdd As String Set objMsg = Application.CreateItem(olMailItem) objMsg.ToRecipients.Add "[e-mail]" objMsg.CCRecipients.Add "[e-mail]" objMsg.Subject = "Subject" objMsg.Body = "Body" If FilePathtoAdd <> "" Then objMsg.Attachments.Add "C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx" End If objMsg.Send 

我在VBA编码方面的经验很less。我从不同的论坛取得了所有这些代码，并对它们进行了修改以适应我的需要。

现在有三个问题。

1. 被保存的附件不是来自最后一封邮件，而是从第二封邮件中取出数据。
2. 我试图通过添加接收邮件的规则来运行脚本，但它只显示了2个不同的脚本。 我尝试了很多方法，但是不能把两者结合起来。
3. 第二个脚本不工作，给出一个错误“运行时错误”-2147467259（8004005）“：”Outlook不识别一个或多个名称“

Answer 1

对于你的第一个问题 ，看到这个

为你的第二个问题

要合并，请将两个脚本合并到一个SUB或者从第一个脚本中调用另一个。

为你的第三个问题

没有称为.ToRecipients和.CCRecipients属性。 将其分别更改为objMsg.To = "[e-mail]"和objMsg.CC = "[e-mail]" 。

也是你的FilePathtoAdd = ""所以你的条件不满足。 要么删除IF条件或更改您的代码

 FilePathtoAdd = "C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx" With objMsg .To = "[e-mail]" .CC = "[e-mail]" .Subject = "Subject" .Body = "Body" .Attachments.Add FilePathtoAdd End With