银行不希望其电子邮件被访问，我并不感到惊讶。您可以更改发件人、添加或删除收件人或更改文本。在不留下痕迹的情况下很难做到这些，但这是可能的。你不想改变任何东西；您只想自动保存附件，以便您的技术人员和 Outlook 允许这样做。
在尝试您的要求中更复杂的部分之前，让我们检查您的要求是否可行。我不知道您对 Excel VBA 了解多少。如果我要求你做一些你不明白的事情，请回来提问。
在方便的地方创建启用宏的工作簿。工作簿的名称无关紧要。
打开工作簿，然后打开 VBA 编辑器。
单击[工具]，然后单击[参考]。您将获得所有可用库的下拉菜单。向下滚动，直到找到“Microsoft Outlook nn.0 对象库”。 “nn”标识正在使用的 Outlook 版本，据我了解，对您而言，该版本将是“14”。单击左侧的框，将出现一个勾号。单击[确定]。这将使您能够从 Excel 访问 Outlook。
在项目资源管理器中，您将看到如下内容：
- VBAProject (YourNameForWorkbook.xlsm)
- Microsoft Excel Objects
Sheet1 (Sheet1)
ThisWorkbook
如果其中一个缺点是加号，请点击那个加号。
单击 [ThisWorkbook]。 VBA 编辑器窗口的右侧将出现一个空白代码区域。将下面的代码复制到该区域。
在代码中，您会发现以“###”开头的行。这些行告诉您必须进行的更改或必须检查的事项。进行必要的更改，然后保存并关闭工作簿。重新打开工作簿。幸运的是，宏将自动运行，默认工作表将报告它所做的事情。它可能会发现错误的电子邮件并保存了错误的附件。这没关系。如果您可以保存任何附件，您可以保存您想要的附件。
Option Explicit
Sub Workbook_Open()
'### Replace "C:\DataArea\SO\" with the name of a disc folder on your system
' Make sure your folder name ends with \.
Const DiscFldrDest As String = "C:\DataArea\SO\"
'### The name of the default worksheet depend on the local language. Replace
' "Sheet1" is this is not the default name for you.
Const WshtOutName As String = "Sheet1"
' ### The subject of the email. Correct if I have misunderstood your comment ' ###
Const Subject As String = "ISIN List: Financial Sanctions - ISIN screening" ' ###
Dim AppOut As Outlook.Application
Dim Found As Boolean
Dim InxA As Long
Dim InxI As Long
Dim OutFldrInbox As Outlook.Folder
Dim RowNext As Long
Dim WshtOut As Worksheet
Set AppOut = CreateObject("Outlook.Application")
With AppOut
With .Session
Set OutFldrInbox = .GetDefaultFolder(olFolderInbox)
End With
End With
Set WshtOut = Worksheets(WshtOutName)
RowNext = WshtOut.Cells(Rows.Count, "A").End(xlUp).Row + 1
'### Change if you prefer different date or time formats
WshtOut.Cells(RowNext, "A").Value = "Macro activated at " & _
Format(Now(), "h:mm") & " on " & _
Format(Now(), "d mmm yy")
RowNext = RowNext + 1
'### GetDefaultFolder is not much use on my system because I have two
' email addresses, each with their own Inbox, neither of which is
' the default Inbox. Probably you only have one work email address
' which is the default for you. To check, the following statement
' outputs the name of the default Inbox's mailbox. Tell me if it is
' not the mail box you want.
WshtOut.Cells(RowNext, "A").Value = Space(6) & "Inbox accessed"
WshtOut.Cells(RowNext, "B").Value = OutFldrInbox.Parent.Name
RowNext = RowNext + 1
Found = False
With OutFldrInbox
For InxI = .Items.Count To 1 Step -1
With .Items(InxI)
If .Subject = Subject And .Attachments.Count > 0 Then '###
WshtOut.Cells(RowNext, "A").Value = Space(6) & "Attachment saved from email" '###
WshtOut.Cells(RowNext, "B").Value = "With subject"
WshtOut.Cells(RowNext, "C").Value = .Subject
RowNext = RowNext + 1
WshtOut.Cells(RowNext, "B").Value = "Received"
'WshtOut.Cells(RowNext, "C").Value = .ReceivedTime
WshtOut.Cells(RowNext, "C").Value = Format(.ReceivedTime, "\a\t h:mm \o\n d mmm yy")
'WshtOut.Cells(RowNext, "C").NumberFormat = "at h:mm on d mmm yy"
RowNext = RowNext + 1
WshtOut.Cells(RowNext, "A").Value = Space(6) & "Attachment saved" '###
For InxA = 1 To .Attachments.Count '###
If UCase(Right$(.Attachments(InxA), 4)) = ".ZIP" Then '###
WshtOut.Cells(RowNext, "B").Value = .Attachments(InxA).Filename '###
.Attachments(1).SaveAsFile DiscFldrDest & .Attachments(1).Filename '###
Found = True '###
Exit For '###
End If '###
Next '###
End If
End With
Next
With WshtOut
If Not Found Then
.Cells(RowNext, "B").Value = "No email with correct subject and a ZIP attachment found"
RowNext = RowNext + 1
End If
.Columns.AutoFit
.Cells(RowNext, "A").Select
End With
End With
End Sub