通过 Excel 发送 Outlook 电子邮件时出错：对象“_Mailitem”的方法“收件人”失败

Question

通过 Excel 2016 发送电子邮件的代码错误。

对象'_Mailitem'的方法'To'失败

相同的代码在 Excel 2010 中也可以使用。

Sub TrainingMails()

    For I = 2 To Range("A65536").End(xlUp).Row

        Application.Wait (Now + TimeValue("0:00:1"))

        Set myOlApp = CreateObject("Outlook.Application")
        Set mail = myOlApp.CreateItem(olmailitem)
        Set attach = mail.Attachments

        mail.To = Cells(I, 1)
        mail.CC = Cells(I, 2)
        mail.BCC = Cells(I, 3)
        mail.Subject = Cells(I, 4)
        mail.Body = Cells(I, 5)

        If Cells(I, 6) <> "" Then
            attach.Add "" & Cells(I, 6) & ""
        End If

        mail.Display

        Set myOlApp = Nothing
        Set mail = Nothing
        Set attach = Nothing

    Next

End Sub

Answer 1

在模块顶部使用Option Explicit 会强制进行一些变量声明。我已经推动了你的代码。折叠您对错误的评论，我添加了一个错误处理程序，此代码现在将跳过有问题的邮件并继续。我仍然很想知道导致问题的单元格中的内容。

Option Explicit

Function To_WithErrorHandler(ByVal mail As Object, ByVal v) As Boolean
    On Error GoTo ErrorHandler
    If IsError(v) Then
        Debug.Print "#Attempt to set To field with #NAME! or #REF!"

    Else
        If Not IsValidEmailAddress(v) Then
            Debug.Print "#Warning: attempt to set To field to '" & v & "' which is not a valid email address!"
        End If

        mail.To = v

        To_WithErrorHandler = True
    End If

    Exit Function
ErrorHandler:
    MsgBox "#Could not set To field of mail object to the value (v) '" & v & "'!"
    Stop
End Function

Function IsValidEmailAddress(ByVal sEmail As String) As Boolean

    Static reEmail As Object 'VBScript_RegExp_55.RegExp
    If reEmail Is Nothing Then
        Set reEmail = CreateObject("VBScript.RegExp")
        reEmail.Pattern = "^\w+@[a-zA-Z_]+?\.[a-zA-Z]{2,3}$"
    End If

    IsValidEmailAddress = reEmail.Test(sEmail)

End Function

Sub TrainingMails()
    Dim I As Long

    Dim wb As Excel.Workbook
    Set wb = Application.Workbooks.Item("ULTIMATE ETO.xlsm") '<----- change this is required

    Dim ws As Excel.Worksheet
    Set ws = wb.Worksheets.Item("ETO") '<----- change this is required


    'Excel Macro: What is olmailitem constant value
    'http://excel-vba-macros.blogspot.co.uk/2013/05/what-is-olmailitem-constant-value.html
    Const olmailitem As Long = 0

    Dim myOlApp As Object
    Set myOlApp = CreateObject("Outlook.Application")


    For I = 2 To ws.Range("A65536").End(xlUp).Row

        Application.Wait (Now() + TimeValue("0:00:01"))

        Dim mail As Object
        Set mail = myOlApp.CreateItem(olmailitem)

        Dim attach As Object
        Set attach = mail.Attachments

        Dim bOk As Boolean

        'mail.To = Cells(I, 1)
        bOk = To_WithErrorHandler(mail, ws.Cells(I, 1))
        If bOk Then
            mail.CC = ws.Cells(I, 2)
            mail.BCC = ws.Cells(I, 3)
            mail.Subject = ws.Cells(I, 4)
            mail.Body = ws.Cells(I, 5)

            If ws.Cells(I, 6) <> "" Then
                attach.Add "" & ws.Cells(I, 6) & ""

            End If

            mail.Display
        End If
        Set mail = Nothing
        Set attach = Nothing

    Next

    Set myOlApp = Nothing

End Sub

Sub TestIsValidEmailAddress()
    Debug.Assert IsValidEmailAddress("nancydavolio@northwind.com")
    Debug.Assert Not IsValidEmailAddress("nancydavolionorthwind.com")
End Sub

但我无法运行，因为我没有安装 Outlook。