The code below works when it is run within the destination Excel workbook.
I want to run the macro from within Outlook.
When I try to add the path to the destination file, it says the subscript is out of range:
Dim DestFile as Object
Set DestFile = Workbooks("T:\3-Lending Systems Analyst\Collections Master Workbook.xlsm")
Is it because it's on an external drive?
Do I need to activate the ExcelApp first and/or Open the Workbook?
Option Explicit
Sub ExtractDataFromOutlookEmail()
' Late binding. Outlook variables declared as Object.
Dim OutlookApp As Object
Dim OutlookNamespace As Object
Dim OutlookFolder As Object
Dim OutlookItem As Object
Dim Attachment As Object
Dim ExcelWorkbook As Workbook
Dim ExcelWorksheet As Worksheet
Dim TempFilePath As String
Dim RangeToExtract As Range
Dim RangeToCopy 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 DestFile = T:\3-Lending Systems Analyst\Collections Master Workbook TESTING.xlsm
Set RangeToExtract = DestFile.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1) ' Change to your desired range******
' Create a new Outlook application
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
' Specify the Outlook folder where the email is located
Set OutlookFolder = OutlookNamespace.GetDefaultFolder(6).Folders("Projects").Folders("Collections").Folders("Daily Reports") ' Change to the appropriate folder
Application.ScreenUpdating = False
' Loop through the emails in the folder
For Each OutlookItem In OutlookFolder.Items
'Debug.Print OutlookItem.Subject
If TypeName(OutlookItem) = "MailItem" Then
' 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) = "Queue Status - Collections.csv" ' Replace with the title of the first attachment
AttachmentTitles(2) = "KPI Collections - Inbound.csv" ' Replace with the title of the second attachment
AttachmentTitles(3) = "KPI Collections - Outbound.csv" ' Replace with the title of the third attachment
Dim AttachmentCount As Long
AttachmentCount = 0
' Loop through the attachments in the email
For Each Attachment In OutlookItem.Attachments
If Attachment.Filename = AttachmentTitles(1) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(1)
' Open the saved Excel attachment
Set ExcelWorkbook = Workbooks.Open(TempFilePath & AttachmentTitles(1))
' Copy the data from the Excel attachment
Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("A2:S12") ' Assuming data is in the first sheet
RangeToCopy.Copy Destination:=RangeToExtract.Offset ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = 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 Attachment
For Each Attachment In OutlookItem.Attachments
If Attachment.Filename = AttachmentTitles(2) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(2)
' Open the saved Excel attachment
Set ExcelWorkbook = Workbooks.Open(TempFilePath & AttachmentTitles(2))
' Copy the data from the Excel attachment
Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("H2:X12") ' Assuming data is in the first sheet
RangeToCopy.Copy Destination:=RangeToExtract.Offset(, 19) ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = 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 Attachment
For Each Attachment In OutlookItem.Attachments
If Attachment.Filename = AttachmentTitles(3) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(3)
' Open the saved Excel attachment
Set ExcelWorkbook = Workbooks.Open(TempFilePath & AttachmentTitles(3))
' Copy the data from the Excel attachment
Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("H2:X12") ' Assuming data is in the first sheet
RangeToCopy.Copy Destination:=RangeToExtract.Offset(, 36) ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = 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 Attachment
End If
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
If Dir(TempFilePath & AttachmentTitles(1)) <> "" Then
Kill TempFilePath & AttachmentTitles(1)
End If
If Dir(TempFilePath & AttachmentTitles(2)) <> "" Then
Kill TempFilePath & AttachmentTitles(2)
End If
If Dir(TempFilePath & AttachmentTitles(3)) <> "" Then
Kill TempFilePath & AttachmentTitles(3)
End If
Application.ScreenUpdating = True
ThisWorkbook.Save
ThisWorkbook.Close
ExcelApp.Quit
End Sub
When running in Excel VBA, Application intrinsic variable points to an instance of the Excel.Application object, and it is exposed in a way that makes all of its properties and methods global, i.e. you don't have to use Application.Worksheets, you can just use Worksheets.
When running inside Outlook VBA, Application points to an instance of the Outlook.Application objects.
You need to take the two points above into account. Off the top of my head, I might have missed something:
Option Explicit
Sub ExtractDataFromOutlookEmail()
' Late binding. Outlook variables declared as Object.
Dim OutlookApp As Object
Dim ExcelApp As Object
Dim ThisWorkbook As Object
Dim OutlookNamespace As Object
Dim OutlookFolder As Object
Dim OutlookItem As Object
Dim Attachment As Object
Dim ExcelWorkbook As Workbook
Dim ExcelWorksheet As Worksheet
Dim TempFilePath As String
Dim RangeToExtract As Range
Dim RangeToCopy As Range
' Set the path where you want to save the extracted data
TempFilePath = Environ$("temp")
'ThisWorkbook must be initialized explicitly
set ExcelApp = CreateObject("Excel.Application")
set ThisWorkbook = ExcelApp.Workbooks.Open("c:\temp\some.worksheet.xlsx")
' Set the range where you want to paste the extracted data
' **** ThisWorkbook is used - code must be in Excel ****
Set RangeToExtract = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1) ' Change to your desired range
' Create a new Outlook application
Set OutlookApp = Application 'Application points to Outlook.Application in Outlook VBA
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
' Specify the Outlook folder where the email is located
Set OutlookFolder = OutlookNamespace.GetDefaultFolder(6).Folders("Projects").Folders("Collections").Folders("Daily Reports") ' Change to the appropriate folder
ExcelApp.ScreenUpdating = False
' Loop through the emails in the folder
For Each OutlookItem In OutlookFolder.Items
'Debug.Print OutlookItem.Subject
If TypeName(OutlookItem) = "MailItem" Then
' 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) = "Queue Status - Collections.csv" ' Replace with the title of the first attachment
AttachmentTitles(2) = "KPI Collections - Inbound.csv" ' Replace with the title of the second attachment
AttachmentTitles(3) = "KPI Collections - Outbound.csv" ' Replace with the title of the third attachment
Dim AttachmentCount As Long
AttachmentCount = 0
' Loop through the attachments in the email
For Each Attachment In OutlookItem.Attachments
If Attachment.Filename = AttachmentTitles(1) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(1)
' Open the saved Excel attachment
Set ExcelWorkbook = Workbooks.Open(TempFilePath & AttachmentTitles(1))
' Copy the data from the Excel attachment
Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("A2:S12") ' Assuming data is in the first sheet
RangeToCopy.Copy Destination:=RangeToExtract.Offset ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = 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 Attachment
For Each Attachment In OutlookItem.Attachments
If Attachment.Filename = AttachmentTitles(2) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(2)
' Open the saved Excel attachment
Set ExcelWorkbook = Workbooks.Open(TempFilePath & AttachmentTitles(2))
' Copy the data from the Excel attachment
Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("H2:X12") ' Assuming data is in the first sheet
RangeToCopy.Copy Destination:=RangeToExtract.Offset(, 19) ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = 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 Attachment
For Each Attachment In OutlookItem.Attachments
If Attachment.Filename = AttachmentTitles(3) Then
' Save the attachment to the temporary location
Attachment.SaveAsFile TempFilePath & AttachmentTitles(3)
' Open the saved Excel attachment
Set ExcelWorkbook = Workbooks.Open(TempFilePath & AttachmentTitles(3))
' Copy the data from the Excel attachment
Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("H2:X12") ' Assuming data is in the first sheet
RangeToCopy.Copy Destination:=RangeToExtract.Offset(, 36) ' Offset to paste data in different columns
' Close the Excel attachment
ExcelWorkbook.Close SaveChanges:=False
' Clean up Excel objects
Set ExcelWorksheet = Nothing
Set ExcelWorkbook = 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 Attachment
End If
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
If Dir(TempFilePath & AttachmentTitles(1)) <> "" Then
Kill TempFilePath & AttachmentTitles(1)
End If
If Dir(TempFilePath & AttachmentTitles(2)) <> "" Then
Kill TempFilePath & AttachmentTitles(2)
End If
If Dir(TempFilePath & AttachmentTitles(3)) <> "" Then
Kill TempFilePath & AttachmentTitles(3)
End If
ExcelApp.ScreenUpdating = True
End Sub