通过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
答案 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。