Integrating 1) Outlook VBA to Save Excel File to Drive 2) Excel VBA to Create New Sheet and Manipulate Data


New Member
Dec 8, 2016
Hi All,

I have Outlook VBA which saves a daily file to the shared drive. I set up an email rule to run the below script upon receiving emails. It loops through the emails and attachments to find and save the daily file.

I also have Excel VBA which I can run with in an active Excel workbook to manipulate data in the workbook. It copies data from an existing sheet to a new sheet.

My goal is to integrate the two scripts so that when Outlook identifies the daily file as an email attachment, it opens it, manipulates the file, and then saves it to the shared drive. Is there an example of something similar to this? If I can find an example, I might be able to figure this out on my own. Any help or direction would be immensely appreciated.

Thank You!

Outlook VBA
Public Sub saveAttachtoDisk2(itm As Outlook.MailItem)Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "\\la\Folder 1\Folder 2\Folder 3"

If itm.Subject Like "*Daily Cash File*" Then
     For Each objAtt In itm.Attachments
     If InStr(objAtt.DisplayName, ".xls") Then
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
          Set objAtt = Nothing
     End If
End If

End Sub
Excel VBA
Public Sub FindAndConvert(itm As Outlook.MailItem)

    Dim i           As Integer
    Dim lastRow     As Long
    Dim myRng       As Range
    Dim myCell      As Range
    Dim myColl      As Collection
    Dim myIterator  As Variant
    Dim wsSource    As Worksheet
    Dim wsTarget    As Worksheet
    Dim colTarget   As Integer
    'Set wsSource variable as "Data" worksheet
    Set wsSource = Sheets("Data")
    'Create new worksheet called "DataImport" to append Access tables
    Sheets.Add.Name = "DataImport"
    'Set wsTarget variable as "DataImport" worksheet
    Set wsTarget = Sheets("DataImport")
    'Create new collection
    Set myColl = New Collection
    'Set colTarget variable to 1 and increase in increments of 1 in for loop
    colTarget = 1
    'Add names for needed columns from "Data" sheet
    myColl.Add "Loan Number"
    myColl.Add "Borrower"
    myColl.Add "Property Address"
    'Count number of rows
    lastRow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
    'Loop through column headers in "Data" sheet and check if they match the names of the required column headers
    For i = 1 To 250
        For Each myIterator In myColl
            If wsSource.Cells(4, i) = myIterator Then
                'Set myRng to the column in the "Data" sheet that matches
                Set myRng = wsSource.Range(wsSource.Cells(4, i), wsSource.Cells(lastRow, i))
                'Paste myRng to "DataImport" sheet
                wsTarget.Range(wsTarget.Cells(1, colTarget), wsTarget.Cells(lastRow - 3, colTarget)) = myRng.Value
                'Increment columns in target up after pasting
                colTarget = colTarget + 1
            End If

End Sub

Forum statistics

Latest member

Some videos you may like

This Week's Hot Topics