从Outlook 2016到2013的VBA代码更新

我在另一台装有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

在工具 - 参考文献中选择了这些问题：

Visual Basic的应用程序

Microsoft Outlook 15.0对象库

OLE自动化

Microsoft Office 15.0对象库

Microsoft Excel 15.0对象库

Microsoft脚本运行时

---

这应该适合你...

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

链接地址: http://www.djcxy.com/p/63767.html

上一篇: VBA code update from Outlook 2016 to 2013

下一篇: Outlook add reference from file