0
votes

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
1

1 Answers

2
votes

Can you:

  1. Save the file
  2. Open the file to determine the correct file name
  3. Close the file
  4. Rename the file

This will then remove a second save function.