Question

代码偶尔抛出运行时错误'424'：需要对象。

电子表格在“C”列中包含一个人的名字，在“BG”列中包含电子邮件地址;当“AO”列中的错误值为＆gt; = 3且“AU”列中有空单元格时，将生成Outlook电子邮件。要关闭循环，会在“AU”列中插入日期戳。

代码位于工作表级别。这个通用表应该作为月份数据的模板;即每年12次复制到同一工作簿中。

有关如何消除错误消息的任何建议？提前谢谢。

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

尝试使用现有实例，否则创建一个尚未运行的新实例

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 Click here

的不错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

Excel VBA电子邮件，偶尔会发生错误

1 个答案: