Outlook / Excel Integration

[chaddres]

Each week, I receive an email with an attached CSV. Is there a VBA I could write (or rule I can create) to automatically save the file to my desktop. I would then like to open the file, copy the data, paste it into an existing XLSX file, and save that file (with a new name) to my desktop as well.



Can this be done?

[gmayor]

The short answer is Yes.

Why do you want to save the CSV to your desktop? If you want to keep it, it would be better filed in a sub folder of My Documents. The desktop is not an ideal filing environment.

If you don't want to keep it, it could better be saved in the user Temp folder.

Much the same applies to the workbook - though I presume you want to keep that?

Where in the existing workbook do you want the CSV to be copied? What determines the filename of the saved Workbook?

The basic script, to run from a rule that identifies the incoming message, and copies the csv to the desktop is as follows:

Sub CustomSaveAttachments(Item As Outlook.MailItem)
Dim olAtt As Attachment
Dim strFileName As String
    If Item.Attachments.Count > 0 Then
        For Each olAtt In Item.Attachments
            If Right(LCase(olAtt.fileName), 3) = "csv" Then
                strFileName = Environ("USERPROFILE") & "\Desktop\" & olAtt.fileName
                olAtt.SaveAsFile strFileName
                'Do stuff with the csv file here
                Exit For
            End If
        Next olAtt
    End If
lbl_Exit:
    Exit Sub
End Sub

The Excel part you may be able to do yourself, or you will have to provide more information.

[chaddres]

Thank you. That helped me get started. For the Excel part, I need to open two files. I need to open T:\Accounting\Master.xlsx and the file that was just saved. I need to copy from the file that was just saved into T:\Accounting\Master.xlsx and then run Macro1 (or I can copy the VBA i already have in Macro1).

[gmayor]

You need a function like the folllowing to import the CSV into the worksheet. I have no idea what the mysterious Macro1 refers to as your Master.xlsx does not support macros. The macro below when called from the earlier macro adds the CSV data to the end of Sheet1 in the Master.xlsx workbook, provided there is data in column A (or the worksheet is empty)

Sub CopyData(strCSV As String)
Const strWB As String = "T:\Accounting\Master.xlsx"
Dim xlApp As Object
Dim xlWb As Object
Dim xlSheet As Object
Dim NextRow As Long
Const xlDelimited As Long = 1

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    'Open the workbook to receive the data

    Set xlWb = xlApp.workbooks.Open(strWB)
    Set xlSheet = xlWb.sheets(1)
    If xlSheet.Range("A1") = "" Then
        NextRow = 1
    Else
        NextRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row + 1
    End If
    'Import the data from the CSV
    With xlSheet.QueryTables.Add(Connection:="TEXT;" & strCSV, _
                                 Destination:=xlSheet.Range("A" & NextRow))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh
    End With
    'Save the workbook
    xlWb.Close SaveChanges:=True
lbl_Exit:
    Set xlApp = Nothing
    Set xlWb = Nothing
    Set xlSheet = Nothing
    Exit Sub
End Sub

Replace
'Do stuff with the csv file here
with

CopyData strFilename

[chaddres]

Thank you so much! You were right, my file was called Master.xlsm. I wasn't thinking, but I realized it as soon as I read what you wrote. I tried to insert my code right before the "save" function, but could not get it to work. I am sure my code is a little sloppy, but it works. Here is what I am using as the code:

Sub FleetMatics()
'
' FleetMatics Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
Cells.Replace What:="10291 MIAMISBURG-SPRINGBORO RD", Replacement:="10291 MIAMISBURG-SPRINGBORO PIKE", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="RYAN A", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="MIKE T", Replacement:="10", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="MICHAEL W", Replacement:="11", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="RANDY H", Replacement:="12", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="ROB L", Replacement:="13", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="DEREK B", Replacement:="4", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="JOSH I", Replacement:="15", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="BRIAN J", Replacement:="16", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="NICK G", Replacement:="17", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="DONALD D", Replacement:="2", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="CHRIS D", Replacement:="3", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="DYLAN M", Replacement:="14", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="FLOYD D", Replacement:="5", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="VONG V", Replacement:="6", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="LEE K", Replacement:="7", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="MIKE K", Replacement:="8", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="LAWRENCE S", Replacement:="9", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.SmallScroll Down:=-6
Columns("B:E").Select
Selection.Delete Shift:=xlToLeft
Columns("H:K").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("G:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("C:C").Select
Selection.Copy
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("R:R").Select
Application.CutCopyMode = False
Selection.Cut
Columns("L:L").Select
Selection.Insert Shift:=xlToRight
Columns("T:T").Select
Selection.Cut
Columns("M:M").Select
Selection.Insert Shift:=xlToRight
Columns("N:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Cut
Columns("N:N").Select
Selection.Insert Shift:=xlToRight
Columns("P:U").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "99999"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Fuel Card ID"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Location Name"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Street"
Range("E1").Select
ActiveCell.FormulaR1C1 = "City"
Range("F1").Select
ActiveCell.FormulaR1C1 = "State"
Range("F1").Select
ActiveCell.FormulaR1C1 = "State/Region"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Postal Code"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Country"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Place ID"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Time"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Gallons Purchased"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Price Per Gallon"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Total Fuel Cost"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Product Description"
Range("A1").Select
Selection.CurrentRegion.Select
ActiveWorkbook.Worksheets("Master Worksheet").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Master Worksheet").Sort.SortFields.Add Key:=Range( _
"A2:A184"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Master Worksheet").Sort
.SetRange Range("A1:O184")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Dim NewLastrow As Long
Lastrow = Cells(Rows.Count, "M").End(xlUp).Row
For i = Lastrow To 1 Step -1
If Cells(i, 12).Value = "" Then
Rows(i).Delete
End If
If IsNumeric(Cells(i, 1).Value) = "False" Then
Rows(i).Delete
End If
Cells(i, 13).Value = Format(Cells(i, 13).Value, "#.00")
If IsNumeric(Cells(i, 1).Value) = "True" Then
Range("N1:N" & Lastrow).Formula = "=L1*M1"
End If
Next
Range("A1").Select
ActiveCell.FormulaR1C1 = "Vehicle External ID"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Total Fuel Cost"
NewLastrow = Cells(Rows.Count, "N").End(xlUp).Row
For i = NewLastrow To 1 Step -1
Cells(i, 14).Value = Format(Cells(i, 14).Value, "#.00")
If Cells(i, 1).Value = "" Then
Rows(i).Delete
End If
Next
Columns("N:N").Select
Selection.NumberFormat = "0.00"
End Sub

[gmayor]

I lost the will to live halfway through your code but it seems that you are altering an existing worksheet to create a new one. Why not simply start with a new blank one? In any case it would be better not to open the existing workbook, but to create a new one from it. That would be at least the ideal starting point.

You can change the macro I posted code not to open the workbook, but to add a workbook using it as a template. That workbook will be unnamed, so you will need to save it before closing it.

I'll take you at your Word that your macro does what you want (it crashes here as I don't have your workbook), but note that you do not need to select ranges/cells in order to process them.

Call the macro with the command (e.g.)

xlApp.Run "PERSONAL.XLSB!FleetMatics"

[chaddres]

I wish I knew enough to understand what you're saying, but I don't. Is there a way to just insert my current code (that I know works) into your code? I just usually do "record macro" and then get the code I need. I just am not knowledgeable to do anything else.

I do appreciate your help! A LOT!

[gmayor]

You have a macro called FleetMatics stored somewhere. Call it with a command line similar to that in my previous message (which assumed it was in the global personal workbook). You can record a macro running the macro to get the part of the command line in quotes.

You cannot simply insert Excel code into the Outlook macro. It is not compatible. You should however be able to run it from Excel using the command line above.

Without access to the Master workbook it is all a bit vague, but looking at it, I would have thought that you should add the command line either immediately after the line

Set xlSheet = xlWb.sheets(1)

if you want it to prepare the sheet to take the CSV data, or immediately before the line :

xlWb.Close SaveChanges:=True

to process the sheet after the data is added.

Just make sure yolu have a backup copy of your Master workbook.