Question

我正在尝试将测试邮件从excel发送到Outlook，但是我收到错误消息：运行时错误287在以下行：

OutMail.Send

请在下面找到我的代码：

Sub sendds()

    Dim OutMail As MailItem
    Dim outlookapp As Outlook.Application
     Dim myInspector As Outlook.Inspector

Set outlookapp = CreateObject("Outlook.application")
Set OutMail = outlookapp.CreateItem(olMailItem)

With OutMail

    .To = "email address"
    .Subject = "test mail"
    .Body = "Hi this is test email"


    OutMail.Send 'Getting error on this line


    End With


 Set outlookapp = Nothing
Set OutMail = Nothing


End Sub

Answer 1

这是因为您的电子邮件或电子邮件地址格式不正确，应该是email@email.com或者用于测试目的.Display

同时将其更改为 .Send

   With OutMail
        .To = "email@address.com"
        .Subject = "test"
        .Body = "Hi this is test email"
        .Send 
    End With

**为解决方法**

    With olMail
        .To = "email"
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Display
        .Send   
    End With

Answer 2

尝试以下方法：

Public Sub emailUsFeature()
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(olMailItem)
With outMail
      .To = "abc@xyz.com; def@xyz.com"
      .CC = "ghi@xyz.com"
      .BCC = "jkl@xyz.com"
      .Subject = "This is the subject."
End With
outMail.display
End Sub

Answer 3

根据评论＆＃34;当我使用outMail.display时，它会显示我要发送的电子邮件，但实际上我想发送电子邮件＆＃34;代码太快了。如果你使用F8，它可能会起作用。

您可以使用Excel等待延迟发送。

这应该适用于所有应用程序，这将是最短的等待期。

Sub sendds_ErrorHandlerWait()

    Dim OutMail As MailItem
    Dim outlookapp As Outlook.Application
    Dim myInspector As Outlook.Inspector

    Set outlookapp = CreateObject("Outlook.application")
    Set OutMail = outlookapp.CreateItem(olMailItem)

    With OutMail

        .To = "email address"
        .Subject = "test mail"
        .body = "Hi this is test email"

        On Error GoTo ErrorHandler
        ' Err.Raise 287 ' for testing
        ' Err.Raise 1   ' for testing
        .Send
        On Error GoTo 0

    End With

ExitRoutine:
    Set outlookapp = Nothing
    Set OutMail = Nothing

    Exit Sub

ErrorHandler:

    Select Case Err

    Case 287
        DoEvents ' To accept clicks and to allow escaping if Outlook never opens
        Debug.Print " <Ctrl> + <Break> to escape"
        Resume

    Case Else
        On Error GoTo 0
        ' Break on other lines with an error
        Resume

End Select

End Sub

您的Outlook设置似乎需要显示。如果没有针对这种情况的修复，您可以使用不可见的显示。

Sub sendds_InspectorRatherThanDisplay()

    Dim OutMail As mailItem
    Dim outlookapp As Outlook.Application
    Dim myInspector As Outlook.Inspector

    Set outlookapp = CreateObject("Outlook.application")
    Set OutMail = outlookapp.CreateItem(olMailItem)

    With OutMail

        .To = "email address"
        .Subject = "test mail"
        .body = "Hi this is test email"

        Set myInspector = .GetInspector
        .Send

    End With

ExitRoutine:
    Set outlookapp = Nothing
    Set OutMail = Nothing
    Set myInspector = Nothing

End Sub

Answer 4

我总是添加DoEvents和Application。请等待1来完成此操作。

我通常不显示电子邮件（此处已注释掉），因此它只是在后台发送。每次都为我工作。

您显然必须使用参数将其从另一个输入。这里也有一个例子。（例如，您可以在每行中包含电子邮件地址，文件名等，并为每行动态发送一封电子邮件）

Sub LoopThroughTable()

    For i = 2 To Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
        email_to = Sheet1.Cells(i, 4).Value
        email_subject = Sheet1.Cells(i, 3).Value
        email_body = Sheet1.Cells(i, 8).Value
        file_path = Sheet1.Cells(i, 2).Value & Sheet1.Cells(i, 3).Value

        SendOutlookMessage email_to, email_subject, file_path, email_body
    Next i

End Sub

Sub SendOutlookMessage(ByVal email_to As String, ByVal email_subject As String, ByVal file_path As String, ByVal email_body As String)

    emailTo = email_to
    emailSub = email_subject
    FullPath = file_path
    HTMLBODY = email_body

    DoEvents
    Application.Wait 1

    Dim olApp As Object
    Dim olMail As Object

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    With olMail
        .to = emailTo
        .Subject = emailSub
        .Attachments.Add (FullPath)

        .HTMLBODY = HTMLBODY
        DoEvents

        '.Display
        Application.Wait 1
        .Send

    End With

    Application.Wait 1

    Set olMail = Nothing
    Set olApp = Nothing

End Sub

希望有帮助。

从Excel发送电子邮件警报到Outlook

4 个答案: