What I am doing here is setting a rule for every email received from a certain source it will save the attachment to the desktop as a .csv file, then open it and then run the code on it. It'll do a text to columns which has been giving me fits but now it's getting through and erring out on a different spot now. The text to columns finds the type of report and the customer number, then it will use those fields to find the path where this file is saving. I currently have it set up to save in a test or actionables folder on the desktop based on the criteria in the If...Then, etc. I was getting stuck on a simple Rows("2:2").Insert code so I have no idea what is happening here!! So frustrating. Anyways, there are typically 7 emails generated off an import to our system so I want this process run every email instance from our system. I get through the first one, then the second one it gets bogged up. It never fails, always on the second email it debugs. I will include the code. I think it's a simple fix, I'm just not smart or experienced enough to identify where the error resides. Code might be ugly, but bear with me. Thanks in advance for the help.
Code:
Public Sub importautomation(itm As Outlook.MailItem)
'saved outlook vba to automate receiving emails from batch import and saving them where they need to go
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim strFilename As String
strFilename = "C:\Users\patrick_barry\Desktop\1.csv"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile strFilename
Set objAtt = Nothing
Next
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Open(filename:=strFilename)
Dim ws As Worksheet
Set ws = xlApp.ActiveWorkbook.ActiveSheet
Dim myRange As range
Set myRange = ws.[A1]
myRange.TextToColumns Destination:=myRange, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1)), TrailingMinusNumbers:=True
ws.Rows("2:2").Insert
ws.range("A2").FormulaR1C1 = _
"=IF(AND(R[-1]C[7]=""Customer"",R[-1]C[8]=""Constraint""),""Customer Constraint"",IF(R[-1]C[7]=""Cost"",""Cost Error"",IF(R[-1]C[7]=""Expiration"",""Expiration Report"",IF(R[-1]C[7]=""Pending"",""Pending Details"",IF(R[-1]C[7]=""Obsolete/Discontinued"",""Obsolete-Discontinued"",IF(R[-1]C[7]=""Upcoming"",""Upcoming Shipment"",IF(R[-1]C[7]=""customer"",""Part Match Report" & _
""")))))))"
ws.range("B2").FormulaR1C1 = _
"=CONCATENATE(R[-1]C[19],"" "",TEXT(R[-1]C,""mm-dd-yyyy""),"" Customer #"",R[-1]C[20])"
ws.range("C2").FormulaR1C1 = _
"=LEFT(INDEX(R[-1],,COUNTA(R[-1])),LEN(INDEX(R[-1],,COUNTA(R[-1])))-1)"
ws.range("D2").FormulaR1C1 = _
"=TEXT(TODAY(),""YYYY"")"
ws.Rows("2:2").Copy
ws.range("2:2").PasteSpecial xlPasteValues
Dim reporttype As String ' sets name of report as variable to use in file path to save
Dim reportdate As String ' sets date of report as variable to use in file path to save
Dim reportcustomer As String 'sets customer number as a variable to use in file path to save
reporttype = ws.range("A2").Value
reportdate = ws.range("B2").Value
reportcustomer = ws.range("C2").Value
If ws.range("A2").Value = "Obsolete-Discontinued" Then 'looks at the Obsolete/Discontinued report and based on criteria it'll save where it needs to
If range("A6").Value = "" Then
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Test\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
Else
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
End If
ElseIf ws.range("A2").Value = "Customer Constraint" Then 'looks at the Customer Constraint report and based on criteria it'll save where it needs to
If range("A7").Value = "" Then
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Test\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
Else
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
End If
ElseIf ws.range("A2").Value = "Cost Error" Then 'looks at the Cost Error report and based on criteria it'll save where it needs to
range("E2").FormulaR1C1 = _
"=IF(COUNT(R[3]C[4]:R[425]C[4])-COUNTIF(R[3]C[4]:R[9998]C[4],0)>0,""Actionables"","""")"
If range("E2").Value = "Actionables" Then
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
Else
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Test\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
End If
ElseIf ws.range("A2").Value = "Expiration Report" Then 'looks at the Expiration report and based on criteria it'll save where it needs to
If ws.range("A5").Value = "" Then
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Test\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
Else
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
End If
ElseIf ws.range("A2").Value = "Pending Details" Then 'looks at the Pending Details and based on criteria it'll save where it needs to
ws.range("F4:F" & Cells(Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=TRIM(RC[-1])"
range("E2").FormulaR1C1 = "=IF(COUNTIF(R[3]C[1]:R[9998]C[1],""Pending Sales"")>0,""Actionables"","""")"
If range("E2").Value = "Actionables" Then
range("F4:F" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
range("E4").PasteSpecial xlPasteValues
range("F4:F" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
range("A4:E4").AutoFilter
ActiveSheet.range("$A$4:$F$" & Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=5, Criteria1:= _
"=*Pending Sales*", Operator:=xlAnd
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
Else
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Test\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
End If
ElseIf ws.range("A2").Value = "Part Match Report" Then 'saves the Upcoming shipment data to actionables folder
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
ElseIf range("A2").Value = "Import Summary" Then 'saves the Import Summary data to actionables folder
ActiveWorkbook.SaveAs filename:= _
"C:\Users\patrick_barry\Desktop\Actionables\" & reporttype & " " & reportdate & reportcustomer & ".xlsx", FileFormat:=51
Excel.Application.Quit
Kill (strFilename)
End If
End Sub
