Open file from Outlook to Excel and save in different format depending on the sender
I use Stack Overflow a lot, but this is my first post. I know enough to be dangerous with VBA.
I originally wrote this piece of code for Outlook - its original purpose was to rename any attachment file and store it in a specific directory (I still need this feature for one person who sends me files designated below as @email email . com).
Now I have multiple people submitting files and you need to modify your script to determine who the sender of this file is and (I know one sender always sends an attachment to an Excel XLSX file, but I need it as a CSV) open the XLSX file in excel and save it as a clean CSV.
Obviously my method is not working and I cannot find cases similar to what I am trying to do on Stack Overflow. Anyone want to help me figure this out? Many thanks to everyone for your help!
This is what I have now, but my If statement is not working ...
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim saveFolder2 As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "c:temp1"
saveFolder2 = "c:\temp2"
' CASE 1
If objAtt.SenderName = "Sender First & Last Name" Then
For Each objAtt In itm.Attachments
' open excel
Workbooks.Open (objAtt)
' save as csv to queue directory for upload to FTP site
ActiveWorkbook.SaveAs FileName:=saveFolder2 & "\" & dateFormat & ".csv",FileFormat:=CSV, CreateBackup:=False
ActiveWorkbook.Saved = True
ActiveWindow.Close
Set objAtt = Nothing
End If
' CASE 2
If objAtt.SenderName = "email@email.com" Then
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & "FC.csv"
Set objAtt = Nothing
Next
End If
End Sub
Following David's changes / suggestions, the code looks like this:
Hi @DavidZemens! Thank you so much for your well thought out answer and for pointing out the problems; your method makes a lot of sense to me. I reconfigured the code with your suggestions and I get the error "Runtime Error 91 - Object Variable or With Locked Variable" which highlights the first line of my "If" statement. Can you determine what I might be doing wrong to get this error?
Option Explicit
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim saveFolder2 As String
Dim dateFormat
Const xlCSV As Long = 6
Dim xlsxPath As String
Dim wb As Object
Dim oExcel As Object
Set oExcel = CreateObject("Excel.Application")
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "c:\temp1"
saveFolder2 = "c:\temp2"
'CASE 1
If objAtt.SenderName = "John Smith" Then
xlsxPath = saveFolder2 & "\" & dateFormat & ".xlsx"
objAtt.SaveAsFile xlsxPath
' use excel to open and save the file as csv
Set wb = oExcel.Workbooks.Open(xlsxPath)
wb.SaveAs FileName:=Replace(xlsxPath, ".xlsx", ".csv"), FileFormat:=xlCSV
wb.Close
oExcel.Quit
End If
'CASE 2
If objAtt.SenderName = "email@email.com" Then
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & ".csv"
Set objAtt = Nothing
Next
End If
End Sub
Following the last suggestions, this is a new code with a new error
The error it gives me when a new email arrives is that the array is out of bounds and allocates a line stating: Set objAtt = itm.Attachments (0)
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim saveFolder2 As String
Dim dateFormat
Const xlCSV As Long = 6
Dim xlsxPath As String
Dim wb As Object
Dim oExcel As Object
Set oExcel = CreateObject("Excel.Application")
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "c:\temp1"
saveFolder2 = "c:\temp2"
xlsxPath = saveFolder2 & "\" & dateFormat & ".xlsx"
**'Case 1**
If itm.SenderName = "John Smith" Then
If itm.Attachments.Count > 0 Then <-- note: I had this as <> and had same error
Set objAtt = itm.Attachments(0)
Else: GoTo EarlyExit
End If
End If
objAtt.SaveAsFile xlsxPath
'## Use excel to open and save the file:
Set wb = oExcel.Workbooks.Open(xlsxPath)
wb.SaveAs FileName:=Replace(xlsxPath, ".xlsx", ".csv"), FileFormat:=xlCSV
wb.Close
'## Get rid of the XLSX version if it no longer needed
On Error Resume Next
Kill xlsxPath
On Error GoTo 0
EarlyExit:
oExcel.Quit
**' Case 2**
If itm.SenderEmailAddress = "email@email.com" Then
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & "FranklinCounty.csv"
Set objAtt = Nothing
Next
End If
source to share
This is mistake:
Workbooks.Open (objAtt)
Because the method Open
expects a string file path, not an object Outlook.Attachment
.
Also, since I don't see an early reference to the object model Excel
, so you can probably expect a compilation error: a custom type not defined on a string Workbooks.Open
. You will need to create an object to store your Excel application:
Dim oExcel as Object
Set oExcel = CreateObject("Excel.Application")
Also, your variable is CSV
not declared or assigned any value, so you will most likely get another error if you get the code to compile.
'## Require explicit declaration of Excel constants, unless you're using early-binding
Const xlCSV as Long = 6
NOTE . Using Option Explicit
at the top of your code modules will prevent you from writing hacky code with undeclared variables, undefined constants, typos in variable names, etc.
Since you cannot use Workbooks.Open
in the application, first you want to save the attachment to disk, then use Excel to open the saved file (from disk), then you can use SaveAs
to save this as another format. This will result in duplicate files (one XLSX and one CSV), you can use the operator Kill
on the one you don't want to keep.
Dim xlsxPath As String
Dim wb as Object 'Excel.Workbook
xlsxPath = saveFolder2 & "\" & dateFormat & ".xlsx"
'## This assumes the file will always be XLSX format
'## get a handle on your mail item:
If itm.Attachments.Count <> 0 Then
Set objAtt = itm.Attachments(1)
Else: Goto EarlyExit
End If
objAtt.SaveAsFile xlsxPath
'## use Excel to open and save the file:
Set wb = oExcel.Workbooks.Open(xlsxPath)
wb.SaveAs FileName:=Replace(xlsxPath, ".xlsx", ".csv"), FileFormat:=xlCSV
wb.Close
'## Get rid of the XLSX version if it no longer needed
On Error Resume Next
Kill xlsxPath
On Error GoTo 0
Then close Excel in front of yours End Sub
:
EarlyExit:
oExcel.Quit()
End Sub
source to share