2
votes

I have a working VBA script for downloading files to a specific location if they match a subject.

I want to auto-convert those files to .xlsx. I found code online that does the second part.

(I have added the reference to Microsoft Excel XX.X Object Library in the VBA library.)

Code for Auto-Download / Rename:

Public Sub save95Attachment(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim filePath As String
Dim tempPath As String
Dim ExcelApp As Excel.Application
Dim wb As Excel.Workbook

saveFolder = "C:\Users\username\Documents\OLAttachments\Temp"
dateFormat = Format(itm.ReceivedTime, "yyyymmdd")

For Each objAtt In itm.Attachments
filePath = saveFolder & "\" & dateFormat & "_file" & ".xls"
    objAtt.SaveAsFile filePath
    Set objAtt = Nothing
Next
End Sub

Code for Conversion to xlsx:

Public Sub ConvertXlsToXlsx(Atmt As Attachment, FullFileName_And_Path As String)
  Dim tempPath As String
  Dim ExcelApp As Excel.Application
  Dim wb As Excel.Workbook

  tempPath = Environ("TEMP") & "\converttemp.xls"
  Atmt.SaveAsFile tempPath

  ExcelApp = New Excel.Application
  Set wb = ExcelApp.Workbooks.Open(tempPath)
  wb.SaveAs FullFileName_And_Path, Excel.XlFileFormat.xlOpenXMLWorkbook
  wb.Close False
  Set wb = Nothing
  ExcelApp.Quit
  Set ExcelApp = Nothing

  Kill wb 'Clean up the temp file
End Sub

After the Outlook rule auto-download / rename, I'd like the file auto-converted to xlsx and the old file deleted.

2

2 Answers

2
votes

After this line

objAtt.SaveAsFile filePath

run this

convertXLStoXLSX filePath

And include this sub in your code:

Sub convertXLStoXLSX(fullFilePath as String)

    Dim xlApp As New Excel.Application 
    Dim wb as Excel.Workbook

    Set wb = xlApp.Workbooks.Open(fullFilePath)
    wb.SaveAs fullFilePath, Excel.XlFileFormat.xlOpenXMLWorkbook
    wb.Close False

    xlApp.Quit

End Sub

Lastly, for the above to work make sure you select Microsoft Excel Object Libary X.X in Tools > References in the VBE.

Actually, it's going to be more efficient if you open / close Excel outside the attachment loop. I'll let you refactor that though.

0
votes

Here is mine...

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)

Dim oAttachment As Outlook.Attachment
Dim filePath As String
Dim xlApp As New Excel.Application
Dim wb As Excel.Workbook

filePath = "\\server\shared_folder\your_File_Name.xlsx"

For Each oAttachment In MItem.Attachments
    oAttachment.SaveAsFile "C:\temp\My_Temp_file_Name.xls"
    Set wb = xlApp.Workbooks.Open("C:\temp\My_Temp_file_Name.xls")
    wb.SaveAs filePath, Excel.XlFileFormat.xlOpenXMLWorkbook
    wb.Close False
    xlApp.Quit
Next


End Sub