vba - 添付ファイル内で見つかった文字列からの Outlook VBA Sourcing 添付ファイル名

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