我正在使用VBA将错误日志发送给多个用户。可以在文件夹中找到此错误日志以及进程日志文件。这些文件的名称上有日期，并且不依赖于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和HELP按钮，并且与通常的MsgBox大小相比有一些小的错误。我不知道错误在哪里，即使我可以使用F8宏，因为它在显示错误后没有突出显示该行。
EDITED
更改了一些声明，我能够完全运行宏。然而，错误日志和进程日志都附加了。我知道我的代码在搜索文件名中带有“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