VBA代码从2016年到2013年的更新

Question

我在另一台有Win10和Office 2016的PC上编写了此代码。它在Outlook规则中使用。它将xml文件从电子邮件保存到文件夹，然后将其更改为其他文件夹中的xlsx文件。在Outlook 2016中，它运行正常。我将其复制到另一本笔记本。

此笔记本电脑具有Win10和Office 2013，并且该代码在Outlook 2013中没有任何错误消息，但xml文件既保存到给定文件夹中，也不会将其转换为xlsx。

此代码中可能是什么问题？

Option Explicit
Public Sub saveconvAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat As String
Dim convFormat As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
saveFolder = "C:UserstulajDocumentsxml"
convFolder = "C:UserstulajDocumentsxls"
dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd HH-mm-ss")
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & dateFormat & objAtt.FileName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(saveFolder)
    If UCase(Right(objAtt.FileName, Len(XML))) = UCase(XML) Then
        NewFileName = convFolder & dateFormat & objAtt.FileName & "_conv.xlsx"
Set ConvertThis = Workbooks.Open(saveFolder & dateFormat & objAtt.FileName)
        ConvertThis.SaveAs FileName:=NewFileName, FileFormat:= _
        xlOpenXMLWorkbook
        ConvertThis.Close
    End If
Next
Set objAtt = Nothing
End Sub

在工具引用中被选择了：

• 视觉基础的放置
• Microsoft Outlook 15.0对象库
• Ole Automation
• Microsoft Office 15.0对象库
• Microsoft Excel 15.0对象库
• Microsoft脚本运行时

Answer 1

这应该对您有用...

Option Explicit
Public Sub saveconvAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim SaveFolder As String
    Dim convFolder As String
    Dim DateFormat As String
    Dim ConvFormat As String
    Dim NewFileName As String
    Dim ConvertThis As Object
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    SaveFolder = "C:Tempxml"
    convFolder = "C:Tempxls"
    DateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd HH-mm-ss ")
    For Each objAtt In itm.Attachments
        Debug.Print objAtt.FileName
        objAtt.SaveAsFile SaveFolder & DateFormat & objAtt.FileName
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(SaveFolder)
        If UCase(Right$(objAtt.FileName, Len("XML"))) = UCase("XML") Then
            NewFileName = convFolder & DateFormat & objAtt.FileName & "_conv.xlsx"
            Set ConvertThis = Workbooks.Open(SaveFolder & DateFormat & objAtt.FileName)
            ConvertThis.SaveAs FileName:=NewFileName, FileFormat:= _
            xlOpenXMLWorkbook
            ConvertThis.Close
        End If
    Next
    Set objAtt = Nothing
End Sub

要测试它，选择电子邮件并运行以下代码

Public Sub Test_Rule()
    Dim Item As MailItem
    Set Item = ActiveExplorer.Selection.Item(1)
    saveconvAttachtoDisk Item
    Set Item = Nothing
End Sub