通过 Excel 发送 Outlook 电子邮件时出错：对象'_Mailitem'的方法'To'失败

Question

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

方法'to of ofbock'_mailitem'失败

相同的代码在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("[e-mail]")
    Debug.Assert Not IsValidEmailAddress("nancydavolionorthwind.com")
End Sub

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