我正在尝试在 Outlook (VBA) 中编写一些代码,这些代码会在附件到达时自动将它们保存到文件中。但是,困难在于我要保存它们的文件名部分来自文件的内容(例如,附件称为“10-0123.xls”并包含来自 Lockyer Valley 的数据。我想要磁盘上的文件称为“10-0123_Lockyer.xls”)。对位置(在本例中为“Lockyer”)的唯一引用在附件中,并且数字(在本例中为“10-0123”)和位置(在本例中为“Lockyer”)随每封电子邮件而变化。
我找到了一种方法,方法是将文件按原样保存到磁盘('10-0123.xls'),打开它,在文件中找到字符串('Lockyer'),保存为新文件名('10 -0123_Lockyer.xls'),然后杀死原始文件('10-0123.xls'),但由于文件很大,运行宏需要一段时间。有没有更有效的方法来实现这一目标?也许是一种直接从 Outlook 打开文件而不先将其保存到磁盘的方法?
代码:
unPrntdRprts = "C:\New Reports"
For Each Attachment In MailItem.Attachments
AtNameExt = Attachment.DisplayName
AtExt = Right(AtNameExt, 4)
AtName = Left(AtNameExt, Len(AtNameExt) - 4)
XLApp.DisplayAlerts = False
Attachment.SaveAsFile (UnPrntdRprts & "\" & AtNameExt)
XLApp.DisplayAlerts = True
XLApp.Workbooks.Open (UnPrntdRprts & "\" & AtNameExt)
SiteName = XLApp.Workbooks(AtNameExt).Worksheets(1).Range("A24").Value
SavName = AtName & "_" & SiteName & AtExt
XLApp.DisplayAlerts = False
XLApp.Workbooks(AtNameExt).SaveAs (UnPrntdRprts & "\" & SavName)
XLApp.DisplayAlerts = True
XLApp.Workbooks(SavName).Close
Kill (UnPrntdRprts & "\" & AtNameExt)
Next