Excel VBA电子邮件，偶尔出现错误

该代码会引发偶尔的运行时错误“424”：必需的对象。

电子表格在“C”列中包含一个人的名字，在“BG”列中包含电子邮件地址; 当“AO”列中的错误值大于等于3且“AU”列中有空单元格时，会生成Outlook电子邮件。 要closures循环，将在“AU”列中插入date戳记。

代码是在图表级别。 这个通用表格应该作为一个月份数据的模板。 即每年复制12次到相同的工作簿。

有关如何消除错误消息的任何build议？ 先谢谢你。

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 'This code cycles through each row and looks for an email address in "BG" column. 'If found and recipient "C"'s 'Total Error Occurences' "AO" value is >=3, an email is generated for a display. 'To close the loop on each row, a date is entered into 'Date Email Generated' "AU". Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Columns("BG").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "?*@?*.?*" And _ Cells(cell.Row, "AO").Value >= 3 And _ IsEmpty(Cells(cell.Row, "AU").Value) = True Then _ Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = cell.Value .Subject = "Test E-mail" .Body = "Dear " & Cells(cell.Row, "C").Value _ & vbNewLine & vbNewLine & _ "This is a " & vbNewLine & _ "test email." & vbNewLine & _ vbNewLine & vbNewLine & _ "Signature" '.Attachments.Add ("C:\test.txt") .Display 'Or use Send End With On Error GoTo 0 Set OutMail = Nothing With Cells(cell.Row, "AU") .Value = Date .NumberFormat = "mm/dd/yy" End With End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub 

Answer 1

尝试使用现有的实例，否则创build一个新的实例，如果还没有运行，

 Dim MyApp As Boolean Dim OutApp As Object Dim OutMail As Object '// Open or Start a new instance of Outlook On Error Resume Next Set OutApp = GetObject(, "Outlook.Application") If Err.Number <> 0 Then MyApp = True Set OutApp = CreateObject("Outlook.Application") End If '// then Create an Outlook Mail Item 

或者从Daniel Pineault中看到很好的Function StartOutlook示例点击这里

 Function StartOutlook() On Error GoTo Error_Handler Dim oOutlook As Object Dim sAPPPath As String If IsAppRunning("Outlook.Application") = True Then 'Outlook was already running Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance of Outlook Else 'Could not get instance of Outlook, so create a new one sAPPPath = GetAppExePath("outlook.exe") 'determine outlook's installation path Shell (sAPPPath) 'start outlook Do While Not IsAppRunning("Outlook.Application") DoEvents Loop Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance of Outlook End If ' MsgBox "Outlook Should be running now, let's do something" Const olMailItem = 0 Dim oOutlookMsg As Object Set oOutlookMsg = oOutlook.CreateItem(olMailItem) 'Start a new e-mail message oOutlookMsg.Display 'Show the message to the user Error_Handler_Exit: On Error Resume Next Set oOutlook = Nothing Exit Function Error_Handler: MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: StartOutlook" & vbCrLf & _ "Error Description: " & Err.Description _ , vbOKOnly + vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function