Question

我正在尝试在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

Answer 1

你可以：

保存文件
打开文件以确定正确的文件名
关闭文件
重命名文件

这将删除第二个保存功能。

Outlook VBA从附件中找到的字符串中获取附件文件名

1 个答案: