nicktaylorgen
New Member
- Joined
- Dec 8, 2016
- Messages
- 11
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!
Nick
Outlook VBA
Excel VBA
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!
Nick
Outlook VBA
Code:
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
Next
End If
End Sub
Excel VBA
Code:
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
Next
Next
End Sub