CODEWITHSUNDEEP
vbaoutlook
vega69
vega69

Reputation: 41

VBA code update from Outlook 2016 to 2013

I wrote this code on an other PC which had Win10 and Office 2016. It is used in an outlook rule. It saves the xml files from the e-mail to a folder and change it to xlsx file in an other folder. In Outlook 2016 it runs properly. I copied it to an other notebook.

This notebook has Win10 and Office 2013 and this code run in Outlook 2013 without any error message but the xml files neither were saved into the given folder and nor were converted to xlsx.

What could be wrong in this code?

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

In Tools-References are selected the falowings:

Upvotes: 1

Views: 890

Answers (1)

0m3r
0m3r

Reputation: 12497

This should work for you...

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

To Test it, select the Email and run the following code

Public Sub Test_Rule()
    Dim Item As MailItem

    Set Item = ActiveExplorer.Selection.Item(1)
    saveconvAttachtoDisk Item

    Set Item = Nothing
End Sub

Upvotes: 1

Related Questions