VBA – search文件夹中的特定文件并将其附加到Outlook邮件中

我正在使用VBA将错误日志发送给多个用户。 这个错误日志可以在一个文件夹中find一个进程日志文件。 这些文件的名称上有date，不依赖于Now（）。

我只想附加错误日志并忽略进程日志。 我已经做了类似的主题多个研究，并能够做出这样的代码：

Sub SendEmailFail() Dim OutlookApp As Outlook.Application Dim OutlookMail As Outlook.MailItem Dim RecipientF As Object Dim myRecipientF As Outlook.Recipient Dim sToF As Object Dim CCf As Object Dim myCCf As Outlook.Recipient Dim sCcF As Object Dim FilesF As VBA.Collection Dim mDoneF As String Dim FileF As Scripting.File Dim AttsF As Outlook.Attachments Application.ScreenUpdating = False Set OutlookApp = New Outlook.Application Set OutlookMail = OutloookApp.CreateItem(0) Set FilesF = GetFilesF mDoneF = Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\ABC\Logs\Done" '=========================================START=========================================' Workbooks("ConfigFile.xlsm").Activate Sheets("Sheet1").Activate Range("C2").Select Set RecipientF = Range(ActiveCell, ActiveCell.End(xlDown)) ActiveCell.Offset(0, 1).Select Set CCf = Range(ActiveCell, ActiveCell.End(xlDown)) On Error Resume Next With OutlookMail .Display End With With OutlookMail 'Get all recipients from Column C For Each sToF In RecipientF Set myRecipientF = OutlookMail.Recipients.Add(sToF) myRecipientF.Type = olTo myRecipientF.Resolve If Not myRecipientF.Resolved Then myRecipientF.Delete End If Next sToF 'Get all CCs from Column D For Each sCcF In CCf Set myCCf = OutlookMail.Recipients.Add(sCcF) myCCf.Type = olCC myCCf.Resolve If Not myCCf.Resolved Then myCCf.Delete End If Next sCcF .Body = ThisWorkbook.Sheets("Sheet1").Range("F2").Value & vbNewLine & _ vbNewLine & ThisWorkbook.Sheets("Sheet1").Range("F3").Value & vbNewLine & _ vbNewLine & ThisWorkbook.Sheets("Sheet1").Range("F4").Value & vbNewLine & _ vbNewLine & "Thank You!" 'Adding Error Logs If FilesF.Count Then Set AttsF = OutlookMail.Attachments For Each File In Files AttsF.Add FileF.Path Next End If End With On Error GoTo 0 Set OutlookMail = Nothing Set OutlookApp = Nothing Application.ScreenUpdating = True End Sub Function GetFilesF() As VBA.Collection Dim FolderF As Scripting.Folder Dim FsoF As Scripting.FileSystemObject Dim FilesF As Scripting.Files Dim FileF As Scripting.File Dim ListF As VBA.Collection Dim mSendF As String Dim mDoneF As String Dim StrFileF As String mSendF = Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\ABC\Logs\Send" mDoneF = Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\ABC\Logs\Done" Set ListF = New VBA.Collection Set FsoF = New Scripting.FileSystemObject Set FolderF = FsoF.GetFolder(mSendF) Set FilesF = FolderF.FilesF For Each FileF In FilesF 'Return only visible files If (FileF.Attributes Or Hidden) <> FileF.Attributes Then StrFileF = Dir(Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\ABC\Logs\Send\*Error Log*") If Len(StrFileF) > 0 Then List.Add FileF End If End If Next Set GetFilesF = ListF End Function 

但是，我遇到了运行时错误“424”：所需的对象。 这个MsgBox只有一个OK和HELPbutton，并且与通常的MsgBox大小相比有一点点小的错误。 我不知道错误在哪里，即使我可以使用F8的macros，因为它显示错误后不会突出显示行。

EDITED

改变了一些声明，我完全可以运行macros。 然而，错误日志和进程日志都是附加的。 我知道我的代码在search文件名为“ERROR LOG”的文件时出现问题。 修改后的代码如下：

 Sub SendEmailFail() Dim OutlookApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim RecipientF As Object Dim myRecipientF As Outlook.Recipient Dim sToF As Object Dim CCf As Object Dim myCCf As Outlook.Recipient Dim sCcF As Object Dim Files As VBA.Collection Dim mDoneF As String Dim FileF As Scripting.File Dim AttsF As Outlook.Attachments Application.ScreenUpdating = False Set OutlookApp = New Outlook.Application Set OutMail = OutlookApp.CreateItem(olMailItem) Set Files = GetFilesF mDoneF = Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\AccentureCIO\Logs\Done" '=========================================START=========================================' Workbooks("ConfigFile.xlsm").Activate Sheets("Sheet1").Activate Range("C2").Select Set RecipientF = Range(ActiveCell, ActiveCell.End(xlDown)) ActiveCell.Offset(0, 1).Select Set CCf = Range(ActiveCell, ActiveCell.End(xlDown)) On Error Resume Next With OutMail .Display End With With OutMail 'Get all recipients from Column C For Each sToF In RecipientF Set myRecipientF = OutMail.Recipients.Add(sToF) myRecipientF.Type = olTo myRecipientF.Resolve If Not myRecipientF.Resolved Then myRecipientF.Delete End If Next sToF 'Get all CCs from Column D For Each sCcF In CCf Set myCCf = OutMail.Recipients.Add(sCcF) myCCf.Type = olCC myCCf.Resolve If Not myCCf.Resolved Then myCCf.Delete End If Next sCcF .Body = ThisWorkbook.Sheets("Sheet1").Range("F2").Value & vbNewLine & _ vbNewLine & ThisWorkbook.Sheets("Sheet1").Range("F3").Value & vbNewLine & _ vbNewLine & ThisWorkbook.Sheets("Sheet1").Range("F4").Value & vbNewLine & _ vbNewLine & "Thank You!" 'Adding Error Logs If Files.Count Then Set AttsF = OutMail.Attachments For Each FileF In Files AttsF.Add FileF.Path Next End If End With On Error GoTo 0 Set OutMail = Nothing Set OutlookApp = Nothing Application.ScreenUpdating = True End Sub Function GetFilesF() As VBA.Collection Dim FolderF As Scripting.Folder Dim FsoF As Scripting.FileSystemObject Dim FilesF As Scripting.Files Dim FileF As Scripting.File Dim ListF As VBA.Collection Dim mSendF As String Dim mDoneF As String Dim StrFileF As String mSendF = Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\AccentureCIO\Logs\Send" mDoneF = Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\AccentureCIO\Logs\Done" Set ListF = New VBA.Collection Set FsoF = New Scripting.FileSystemObject Set FolderF = FsoF.GetFolder(mSendF) Set Files = FolderF.Files For Each FileF In Files 'Return only visible files If (FileF.Attributes Or Hidden) <> FileF.Attributes Then StrFileF = Dir(Environ("userprofile") & _ "\Documents\Automation Anywhere Files\Automation Anywhere\My Reports\AccentureCIO\Logs\Send\*Error Log*") If Len(StrFileF) > 0 Then ListF.Add FileF End If End If Next Set GetFilesF = ListF End Function