VBA to take a CSV Outlook Attachment and Save it as XLSX

%3CLINGO-SUB%20id%3D%22lingo-sub-1077064%22%20slang%3D%22en-US%22%3EVBA%20to%20take%20a%20CSV%20Outlook%20Attachment%20and%20Save%20it%20as%20XLSX%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1077064%22%20slang%3D%22en-US%22%3E%3CP%3EHi%2C%20So%20each%20day%20I%20get%20emails%20with%20attachments%20in%20csv%20form%20but%20I%20need%20them%20to%20be%20in%20xlsx%20form%20when%20saved.%20So%20what%20I%20am%20trying%20to%20do%20is%20use%20a%20rule%20within%20outlook%20that%20will%20take%20the%20CSV%20file%2C%20convert%20it%2C%20and%20save%20it%20as%20a%20xlsx%20in%20another%20folder.%20Here%20is%20what%20I%20have%20so%20far%20but%20it%20doesn't%20seem%20to%20function%20properly.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-markup%22%3E%3CCODE%3EPublic%20Sub%20SaveCSVtoExcel(itm%20As%20Outlook.MailItem)%0A%0ADim%20oAttachment%20As%20Outlook.Attachment%0ADim%20mySaveFolder%20As%20String%0ADim%20objSelection%20As%20Outlook.Selection%0ADim%20myFileName%20As%20String%0ADim%20DateFormat%0ADim%20objOA%20As%20Outlook.Application%0A%0ADim%20myWB%20As%20Excel.Workbook%0ADim%20myApp%20As%20Excel.Application%0A%0ASet%20objOA%20%3D%20CreateObject(%22Outlook.Application%22)%0ASet%20objSelection%20%3D%20obj.ActiveExplorer.Selection%0A%0AmySaveFolder%20%3D%20%22myfolder%2Fforsaving%22%0ADebug.Print%20itm.Subject%0ADateFormat%20%3D%20Format(Now%2C%20%22mmddyy%22)%0A%0AFor%20Each%20oAttachment%20In%20itm.Attachments%0AmyFileName%20%3D%20mySaveFolder%20%26amp%3B%20%22Inventory%20Balance%22%20%26amp%3B%20%22%20%22%20%26amp%3B%20DateFormat%0A%0ASelect%20Case%20Right(objAtt%2C%20Len(objAtt)%20-%20InStrRev(objAtt%2C%20%22.%22))%0A%0ACase%20%22csv%22%0AobjAtt.SaveAsFile%20attchmtName%0A%0AIf%20myApp%20Is%20Nothing%20Then%0ASet%20myApp%20%3D%20CreateObject(%22Excel.Application%22)%0AEnd%20If%0ASet%20myWB%20%3D%20myApp.Workbooks.Open(attchmtName)%0A%0AmyWB.SaveAs%20saveFolder%20%26amp%3B%20DateFormat%20%26amp%3B%20%22%20%22%20%26amp%3B%20objAtt.FileName%20%26amp%3B%20%22.xlsx%22%2C%20FileFormat%3A%3D51%0A%0AmyWB.Close%20False%0A%0AKill%20attchmtName%0A%0AmyApp.Quit%0A%0ACase%20%22xlsx%22%2C%20%22xlsm%22%0A%0A'%20save%20in%20original%20format%0AobjAtt.SaveAsFile%20attchmtName%0A%0AEnd%20Select%0A%0ANext%0A%0ASet%20myWB%20%3D%20Nothing%0ASet%20myApp%20%3D%20Nothing%0A%0ASet%20objOA%20%3D%20Nothing%0ASet%20objSelection%20%3D%20Nothing%0A%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECan%20anyone%20let%20me%20know%20what%20I%20can%20do%20to%20make%20this%20work%3F%20Thank%20you!%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EEdit%3A%20Changed%20%22x%22%20to%20%22.xlsx%22%20(still%20need%20advice%20on%20fix)%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1077064%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EDeveloper%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EOffice%20365%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
Highlighted
Visitor

Hi, So each day I get emails with attachments in csv form but I need them to be in xlsx form when saved. So what I am trying to do is use a rule within outlook that will take the CSV file, convert it, and save it as a xlsx in another folder. Here is what I have so far but it doesn't seem to function properly.

 

 

 

 

Public Sub SaveCSVtoExcel(itm As Outlook.MailItem)

Dim oAttachment As Outlook.Attachment
Dim mySaveFolder As String
Dim objSelection As Outlook.Selection
Dim myFileName As String
Dim DateFormat
Dim objOA As Outlook.Application

Dim myWB As Excel.Workbook
Dim myApp As Excel.Application

Set objOA = CreateObject("Outlook.Application")
Set objSelection = obj.ActiveExplorer.Selection

mySaveFolder = "myfolder/forsaving"
Debug.Print itm.Subject
DateFormat = Format(Now, "mmddyy")

For Each oAttachment In itm.Attachments
myFileName = mySaveFolder & "Inventory Balance" & " " & DateFormat

Select Case Right(objAtt, Len(objAtt) - InStrRev(objAtt, "."))

Case "csv"
objAtt.SaveAsFile attchmtName

If myApp Is Nothing Then
Set myApp = CreateObject("Excel.Application")
End If
Set myWB = myApp.Workbooks.Open(attchmtName)

myWB.SaveAs saveFolder & DateFormat & " " & objAtt.FileName & ".xlsx", FileFormat:=51

myWB.Close False

Kill attchmtName

myApp.Quit

Case "xlsx", "xlsm"

' save in original format
objAtt.SaveAsFile attchmtName

End Select

Next

Set myWB = Nothing
Set myApp = Nothing

Set objOA = Nothing
Set objSelection = Nothing

End Sub

 

 

 

 

Can anyone let me know what I can do to make this work? Thank you!

 

Edit: Changed "x" to ".xlsx" (still need advice on fix)

 

0 Replies