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