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

发布于 2024-12-03 18:24:44 字数 1243 浏览 1 评论 0原文

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

原文

I am trying to write some code in Outlook (VBA) that will automatically save attachments to file as they arrive. However, the difficulty is that the filename that I want to save them as is partially drawn from the contents of the file (eg. attachment is called '10-0123.xls' and contains data from Lockyer Valley. I want the file on disk to be called '10-0123_Lockyer.xls'). The only reference to the location ('Lockyer' in this case) is in the attachment, and both the number ('10-0123' in this case) and location ('Lockyer' in this case) change with each email.

I have found a way to do this by saving the file to disk as is ('10-0123.xls'), opening it, finding the string in the file ('Lockyer'), saving as under the new filename ('10-0123_Lockyer.xls'), then killing the original file ('10-0123.xls'), but as the files are quite large it takes a while to run the macro. Is there a more efficient way of achieving this? Maybe a way to open the file directly from outlook, without saving it to disk first?

Code:

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

分享到QQ

分享到微博