Outlook VBA從郵件中保存附件，然后將附件數據復制到另一個excel中並通過郵件發送發送excel

Question

我正在嘗試創建 Outlook VBA 代碼以將特定郵件中的附件保存到文件夾中，然后將附件中的數據復制粘貼到另一個 excel 中。然后將第二個 excel 郵寄到某些 ID。

我創建了一個規則 1st 將傳入的自動郵件移動到特定的郵件文件夾，然后將其附件保存到桌面文件夾。保存附件后，數據被復制到第二個 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 "alias@mail.com"
 objMsg.CCRecipients.Add "xx@yy.com"
 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 編碼方面的經驗很少。我從不同的論壇中獲取了所有這些代碼，並對其進行了修改以滿足我的需要。

現在有3個問題。

1. 正在保存的附件不是來自最后一封郵件，而是從第二封郵件中獲取數據。
2. 我試圖通過添加接收郵件的規則來運行腳本，但它只顯示了 2 個不同的腳本。 我嘗試了很多方法，但無法將它們結合起來。
3. 第二個腳本不起作用，出現錯誤“運行時錯誤'-2147467259（8004005）'：“Outlook 無法識別 1 個或多個名稱”

Answer 1

對於您的第一個問題，請參閱此

對於你的第二個問題

要合並，要么在一個SUB加入兩個腳本，要么從第一個調用另一個腳本。

對於你的第三個問題

沒有名為.ToRecipients和.CCRecipients屬性。 分別將其更改為objMsg.To = "alias@mail.com"和objMsg.CC = "xx@yy.com" 。

還有你的FilePathtoAdd = ""所以你的 if 條件不滿足。 刪除該 IF 條件或將您的代碼更改為此

FilePathtoAdd = "C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx"

With objMsg
    .To = "alias@mail.com"
    .CC = "xx@yy.com"
    .Subject = "Subject"
    .Body = "Body"
    .Attachments.Add FilePathtoAdd
End With