**Please move if this is in the wrong thread group**
I believe I have finally spliced a VBA code together in order to do what I'm trying to accomplish however I can't seem to get the specifics correct.
Scenario - I receive 3 emails every night at 8pm that contain 1 excel/csv attachment each. I would like this code to sweep the emails and extract data from each attachment, taking a specified Range from each attachment and paste that data into 3 separate specific Ranges within an external locally saved master excel worksheet.
My details that I still need to input:
AttachmentTitles(1) = "Queue Status - Collections.csv"
AttachmentTitles(2) = "KPI Collections - Inbound.csv"
AttachmentTitles(3) = "KPI Collections - Outbound.csv"
' Copy the data from the Excel attachment
"Queue Status - Collections.csv" - Range = "A2:S12"
"KPI Collections - Inbound.csv" - Range = "H2:X12"
"KPI Collections - Outbound.csv" - Range = "H2:X12"
' Set the range where you want to paste the extracted data
"Queue Status - Collections.csv" - Range = "A2:S12" data should always paste into the next available Row in "Collections Master Workbook.xlsx"
"KPI Collections - Inbound.csv" - Range = "H2:X12" data should always paste into the 20th column of the same available Row as previous
"KPI Collections - Outbound.csv" - Range = "H2:X12" data should always paste into the 37th column of the same available Row as previous
' Specify the Outlook folder where the email is located
Inbox.Projects.Collections.Daily Reports - It's a sub-sub-subfolder if that makes sense?
So ultimately there should always be a total 11 Rows and 53 Columns of data pasted into "Collections Master Workbook.xlsx" - that's the final goal
Thank you so much for your help, and if I need a path for the "Collections Master Workbook.xlsx" please just let me know.
I have tried multiple combinations with no success. The first error I come across is it gives me a "compile error: user-defined type not defined" and then it highlights the Dim RangeToExtract As Range line at the top?
Here is what I have so far as a template:
Sub ExtractDataFromOutlookEmail()
Dim OutlookApp As Object
Dim OutlookNamespace As Object
Dim OutlookFolder As Object
Dim OutlookItem As Object
Dim ExcelApp As Object
Dim ExcelWorkbook As Object
Dim ExcelWorksheet As Object
Dim Attachment As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim RangeToExtract As Range
' Set the path where you want to save the extracted data
TempFilePath = Environ$("temp") & ""
' Set the range where you want to paste the extracted data
Set RangeToExtract = ThisWorkbook.Sheets("Sheet1").Range("A1") ' Change to your desired range
' Create a new Outlook application
Set OutlookApp = CreateObject("Outlook.Application")
' Specify the Outlook folder where the email is located
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set OutlookFolder = OutlookNamespace.GetDefaultFolder(olFolderInbox) ' Change to the appropriate folder
' Loop through the emails in the folder
For Each OutlookItem In OutlookFolder.Items
' Check if the email has the desired attachments
If OutlookItem.Attachments.Count >= 1 Then
' Check if the attachments have specific titles
Dim AttachmentTitles(1 To 3) As String
AttachmentTitles(1) = "Attachment1.xlsx" ' Replace with the title of the first attachment
AttachmentTitles(2) = "Attachment2.xlsx" ' Replace with the title of the second attachment
AttachmentTitles(3) = "Attachment3.xlsx" ' Replace with the title of the third attachment
Dim AttachmentCount As Integer
AttachmentCount = 0
' Loop through the attachments in the email
For Each Attachment In OutlookItem.Attachments
For i = 1 To 3
If Attachment.Filename = AttachmentTitles(i) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(i)
' Create a new Excel application
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = False
' Open the saved Excel attachment
Set ExcelWorkbook = ExcelApp.Workbooks.Open(TempFilePath & AttachmentTitles(i))
' Copy the data from the Excel attachment
Set ExcelWorksheet = ExcelWorkbook.Sheets(1) ' Assuming data is in the first sheet
ExcelWorksheet.UsedRange.Copy Destination:=RangeToExtract.Offset(, AttachmentCount * 3) ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
ExcelApp.Quit
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = Nothing
Set ExcelApp = Nothing
' Increment the attachment count
AttachmentCount = AttachmentCount + 1
' Exit the loop if all three attachments are processed
If AttachmentCount >= 3 Then Exit For
End If
Next i
Next Attachment
' Exit the loop after processing the email
Exit For
End If
Next OutlookItem
' Clean up Outlook objects
Set OutlookItem = Nothing
Set OutlookFolder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
' Delete the temporary Excel files
For i = 1 To 3
If Dir(TempFilePath & AttachmentTitles(i)) <> "" Then
Kill TempFilePath & AttachmentTitles(i)
End If
Next i
End Sub
I believe I have finally spliced a VBA code together in order to do what I'm trying to accomplish however I can't seem to get the specifics correct.
Scenario - I receive 3 emails every night at 8pm that contain 1 excel/csv attachment each. I would like this code to sweep the emails and extract data from each attachment, taking a specified Range from each attachment and paste that data into 3 separate specific Ranges within an external locally saved master excel worksheet.
My details that I still need to input:
AttachmentTitles(1) = "Queue Status - Collections.csv"
AttachmentTitles(2) = "KPI Collections - Inbound.csv"
AttachmentTitles(3) = "KPI Collections - Outbound.csv"
' Copy the data from the Excel attachment
"Queue Status - Collections.csv" - Range = "A2:S12"
"KPI Collections - Inbound.csv" - Range = "H2:X12"
"KPI Collections - Outbound.csv" - Range = "H2:X12"
' Set the range where you want to paste the extracted data
"Queue Status - Collections.csv" - Range = "A2:S12" data should always paste into the next available Row in "Collections Master Workbook.xlsx"
"KPI Collections - Inbound.csv" - Range = "H2:X12" data should always paste into the 20th column of the same available Row as previous
"KPI Collections - Outbound.csv" - Range = "H2:X12" data should always paste into the 37th column of the same available Row as previous
' Specify the Outlook folder where the email is located
Inbox.Projects.Collections.Daily Reports - It's a sub-sub-subfolder if that makes sense?
So ultimately there should always be a total 11 Rows and 53 Columns of data pasted into "Collections Master Workbook.xlsx" - that's the final goal
Thank you so much for your help, and if I need a path for the "Collections Master Workbook.xlsx" please just let me know.
I have tried multiple combinations with no success. The first error I come across is it gives me a "compile error: user-defined type not defined" and then it highlights the Dim RangeToExtract As Range line at the top?
Here is what I have so far as a template:
Sub ExtractDataFromOutlookEmail()
Dim OutlookApp As Object
Dim OutlookNamespace As Object
Dim OutlookFolder As Object
Dim OutlookItem As Object
Dim ExcelApp As Object
Dim ExcelWorkbook As Object
Dim ExcelWorksheet As Object
Dim Attachment As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim RangeToExtract As Range
' Set the path where you want to save the extracted data
TempFilePath = Environ$("temp") & ""
' Set the range where you want to paste the extracted data
Set RangeToExtract = ThisWorkbook.Sheets("Sheet1").Range("A1") ' Change to your desired range
' Create a new Outlook application
Set OutlookApp = CreateObject("Outlook.Application")
' Specify the Outlook folder where the email is located
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set OutlookFolder = OutlookNamespace.GetDefaultFolder(olFolderInbox) ' Change to the appropriate folder
' Loop through the emails in the folder
For Each OutlookItem In OutlookFolder.Items
' Check if the email has the desired attachments
If OutlookItem.Attachments.Count >= 1 Then
' Check if the attachments have specific titles
Dim AttachmentTitles(1 To 3) As String
AttachmentTitles(1) = "Attachment1.xlsx" ' Replace with the title of the first attachment
AttachmentTitles(2) = "Attachment2.xlsx" ' Replace with the title of the second attachment
AttachmentTitles(3) = "Attachment3.xlsx" ' Replace with the title of the third attachment
Dim AttachmentCount As Integer
AttachmentCount = 0
' Loop through the attachments in the email
For Each Attachment In OutlookItem.Attachments
For i = 1 To 3
If Attachment.Filename = AttachmentTitles(i) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(i)
' Create a new Excel application
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = False
' Open the saved Excel attachment
Set ExcelWorkbook = ExcelApp.Workbooks.Open(TempFilePath & AttachmentTitles(i))
' Copy the data from the Excel attachment
Set ExcelWorksheet = ExcelWorkbook.Sheets(1) ' Assuming data is in the first sheet
ExcelWorksheet.UsedRange.Copy Destination:=RangeToExtract.Offset(, AttachmentCount * 3) ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
ExcelApp.Quit
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = Nothing
Set ExcelApp = Nothing
' Increment the attachment count
AttachmentCount = AttachmentCount + 1
' Exit the loop if all three attachments are processed
If AttachmentCount >= 3 Then Exit For
End If
Next i
Next Attachment
' Exit the loop after processing the email
Exit For
End If
Next OutlookItem
' Clean up Outlook objects
Set OutlookItem = Nothing
Set OutlookFolder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
' Delete the temporary Excel files
For i = 1 To 3
If Dir(TempFilePath & AttachmentTitles(i)) <> "" Then
Kill TempFilePath & AttachmentTitles(i)
End If
Next i
End Sub
