下面的代码在目标Excel工作簿中运行时效果非常好。我最终想从Outlook中运行宏。当我尝试将路径添加到目标文件时遇到问题:
Dim DestFile as Object
Set DestFile = Workbooks("T:\3-Lending Systems Analyst\Collections Master Workbook.xlsm")
它说下标超出范围。是因为它在外部驱动器上吗?我需要先激活ExcelApp和/或打开工作簿吗?我能想到的办法都试过了。
谢谢您的帮助!
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
' **** 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 = 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
End Sub
1条答案
按热度按时间bwleehnv1#
1.当在Excel中运行时,Application内部变量指向
Excel.Application
对象的示例,并且它以一种使其所有属性和方法全局化的方式公开,即你不必使用Application.Worksheets
,你可以使用Worksheets
。1.当在Outlook Explorer中运行时,
Application
指向Outlook.Application
对象的示例。你必须考虑到上面的两点。在我的脑海中,我可能错过了一些东西: