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:\Users\tulaj\Documents\xml\"
convFolder = "C:\Users\tulaj\Documents\xls\"
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

在工具中 - 参考选择了falowings：

Visual Basic for Aplications
Microsoft Outlook 15.0对象库
OLE自动化
Microsoft Office 15.0对象库
Microsoft Excel 15.0对象库
Microsoft Scripting Runtime

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:\Temp\xml\"
    convFolder = "C:\Temp\xls\"
    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

从Outlook 2016到2013的VBA代码更新

1 个答案: