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

时间:2017-11-28 16:44:42

标签: excel excel-vba vba

通过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

1 个答案:

答案 0 :(得分:0)

在模块顶部使用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 强制进行一些变量声明。我已按你的代码轻推了一下。折叠关于错误的评论我添加了错误处理程序,此代码现在将跳过有问题的邮件并继续。我仍然有兴趣知道单元格中导致问题的原因。

is_pipe

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