将转换 xls 到 xlsx 功能添加到 Outlook VBA 代码答案

【问题标题】：Add convert xls to xlsx functionality to Outlook VBA code将转换 xls 到 xlsx 功能添加到 Outlook VBA 代码
【发布时间】：2018-05-24 20:17:38
【问题描述】：

如果文件与主题匹配，我有一个有效的 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 并删除旧文件。

【问题讨论】：

标签： excel vba outlook

【解决方案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

最后，为使上述操作生效，请确保您在 VBE 的 Tools > References 中选择 Microsoft Excel Object Libary X.X。

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

【讨论】：

感谢您的回复！我尝试了您所说的，用您编写的代码替换了我的 convertXLStoXLSX 代码并添加到 convertXLStoXLSX filePath 行中，但它没有用。它保存到预期的文件位置，但作为 XLS 文件。
当我将你的 convertXLStoXLSX 添加到我的之外时，程序中什么也不会发生。收到电子邮件后，它甚至没有保存。
@user9843227 - 关于您的第二条评论，您不能在一个项目中拥有两个同名的模块。这就是它不会运行的原因。在第一条评论中，将 wb.SaveAs fullFilePath, ... 替换为 'wb.SaveAs Replace(fullFilePath,".xlsx",""), ...` 看看是否可行。
刚刚尝试使用wb.SaveAs Replace(fullFilePath,".xlsx",""), ...，但还是不行。现在，当我单击它保存的 xls 文件时，前 5 秒显示“此文件已被用户锁定以供编辑”，然后它让我可以正常打开它，但它被保存为 XLS。跨度>
@user9843227 - 这里有一些我不记得的技巧。我发现我也打错了，试试Replace(fullFilePath, ".xls", "") 和/或Replace(fullFilePath, ".xls", ".xlsx")

【解决方案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

【讨论】：