Question

我有一个可用的VBA脚本，用于将文件下载到特定位置（如果它们与主题匹配）。

我想将这些文件自动转换为.xlsx。我在网上找到了第二部分的代码。

（我在VBA库中添加了对Microsoft Excel XX.X对象库的引用。）

自动下载/重命名代码：

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

转换为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

在Outlook规则自动下载/重命名后，我希望将文件自动转换为xlsx并删除旧文件。

Answer 1

此行之后

objAtt.SaveAsFile filePath

运行此

convertXLStoXLSX filePath

并在您的代码中包含此子代码：

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

最后，要完成上述工作，请务必在工具＆gt;中选择Microsoft Excel Object Libary X.X。 VBE中的参考文献。

实际上，如果在附件循环外打开/关闭Excel，效率会更高。我会让你重构那个。

Answer 2

这是我的...

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

将xlsx功能转换为xlsx功能到Outlook VBA代码

2 个答案: