從Outlook 2016到2013的VBA代碼更新

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腳本運行時

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