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

      

+3


source to share


1 answer


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

      

+3


source







All Articles