我在 excel 中有一个电子邮件地址列表，我需要向这些地址发送电子邮件。主题和正文位于电子邮件地址之外的单元格中

Question

正如本文主题所述，我正在尝试通过运行宏来自动发送电子邮件，这样如果单元格 J2 中包含“发送提醒”字样，则单元格 K2 中的电子邮件地址应发送电子邮件单元格 L2 中的主题标题和单元格 M 中的正文。我有一个电子邮件列表，范围从单元格 K2:K59

目前我有以下代码：

    Sub SendEm()

Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
lr = Cells(Rows.Count, "K").End(xlUp).Row
Set Mail_Object = CreateObject("Outlook.Application")
For i = 2 To lr
    With Mail_Object.CreateItem(o)
        .Subject = Range("L2").Value
        .To = Range("K" & i).Value
        .Body = Range("M2").Value
        .Send
    End With
Next i
    MsgBox "E-mail successfully sent", 64
    Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub

我已经打开了 Outlook，其中选择了 Microsoft Outlook 14.0 对象库的引用，如果我尝试调试它，我收到一条错误消息：“运行时错误 '287' 应用程序定义器或对象定义错误，它突出显示 .Send in my code。

谁能帮忙指出我做错了什么？我尝试了各种类型的代码来根据不同的 youtube 视频等发送电子邮件，但似乎每次都遇到这个错误！

提前感谢您的帮助！

Edit1：我根据建议将代码更新为以下内容，现在是另一个问题：

Private Sub CommandButton21_Click()
'~~> Excel Objects/Variables
Dim ws As Worksheet
Dim lRow As Long, i As Long

'~~> Outlook Objects/Variables
Dim OutApp As Object
Dim OutMail As Object
Dim emailRange As Range, cl As Range
Dim sTo As String
Dim subjectRange As Range, c2 As Range
Dim sSubject As String
Dim bodyRange As Range, c3 As Range
Dim sBody As String


'~~> Set your worksheet here
Set ws = ThisWorkbook.Sheets("Sheet11")
'~~> Open Outlook
Set OutApp = CreateObject("Outlook.Application")

With ws

'~~> Get last row from Col J as that is what we
    '~~> are going to check for the condition
    lRow = .Range("J" & .Rows.Count).End(xlUp).Row

 '~~> Loop through the rows
    For i = 2 To lRow
        If .Range("J" & i).Value = "Send Reminder" Then
            '~~> Create new email

Set emailRange = Worksheets("Sheet11").Range("K2:K59")

         For Each cl In emailRange

         sTo = sTo & ";" & cl.Value
         Next
         sTo = Mid(sTo, 2)

Set subjectRange = Worksheets("Sheet11").Range("L2:L59")
          For Each c2 In subjectRange

          sSubject = sSubject & ";" & c2.Value
          Next
          sSubject = Mid(sSubject, 2)

Set bodyRange = Worksheets("Sheet11").Range("M2:M59")

        For Each c3 In bodyRange
        sBody = sBody & ":" & c3.Value
        Next
        sBody = Mid(sBody, 2)

            Set OutMail = OutApp.CreateItem(0)

'On Error Resume Next
            With OutMail
                '~~> Customize your email
                 .To = ""
                 .CC = sTo
                 .BCC = ""
                 .Subject = "typed subject1" & sSubject
                 .Body = ""

                 .Display '<~~ Change to .Send to actually send it
            End With
        End If
    Next i
End With
End Sub

此代码在 Outlook 中打开多个窗口，其中包含 K2:K59 中列出的所有电子邮件。例如，如果 J2:J59 中的三个单元格有发送提醒，我打开 3 个电子邮件窗口，其中所有电子邮件都列在 cc 框中，而不是多个窗口包含单个电子邮件或一个窗口包含所有电子邮件。我想我必须以某种方式关闭循环，但不确定如何！感谢您的帮助。

Answer 1

Mail_Object.CreateItem(o)

不应该是这样的

Mail_Object.CreateItem(0)

0 而不是o

在下面的代码中，您不需要设置对 MS Outlook 对象库的引用。我在 MS Outlook 中使用 Late Binding。

试试这个（未经测试）

我已经对代码进行了注释，因此您理解代码不会有问题，但如果您这样做了，那么只需发回 :)

Option Explicit

Sub Sample()
    '~~> Excel Objects/Variables
    Dim ws As Worksheet
    Dim lRow As Long, i As Long

    '~~> Outlook Objects/Variables
    Dim OutApp As Object
    Dim OutMail As Object

    '~~> Set your worksheet here
    Set ws = ThisWorkbook.Sheets("Sheet1")
    '~~> Open Outlook
    Set OutApp = CreateObject("Outlook.Application")

    With ws
        '~~> Get last row from Col J as that is what we
        '~~> are going to check for the condition
        lRow = .Range("J" & .Rows.Count).End(xlUp).Row

        '~~> Loop through the rows
        For i = 2 To lRow
            If .Range("J" & i).Value = "Send Reminder" Then
                '~~> Create new email
                Set OutMail = OutApp.CreateItem(0)

                With OutMail
                    '~~> Customize your email
                    .To = ws.Range("K" & i).Value
                    .Subject = ws.Range("L" & i).Value
                    .Body = ws.Range("M" & i).Value

                    .Display '<~~ Change to .Send to actually send it
                End With
            End If
        Next i
    End With
End Sub

Answer 2

由于您已打开 Outlook，您无需执行任何复杂操作。

Set Mail_Object = GetObject(, "Outlook.Application")

Answer 3

我昨天做了类似的事情，这是我使用的代码，希望对您有所帮助。

Sub EmailCopy()
Dim oApp, oMail As Object, X As Long, MyBody As String
    Application.ScreenUpdating = False
    On Error Resume Next
    Set oApp = CreateObject("Outlook.Application")
    For X = 2 To Range("A" & Rows.Count).End(xlUp).Row
        MyBody = Replace(Join(Application.Transpose(Range("E5:E" & Range("D" & Rows.Count).End(xlUp).Row - 1).Value), vbLf & vbLf), "<FirstName>", Range("B" & X).Text)
        MyBody = MyBody & vbLf & vbLf & Join(Application.Transpose(Range("E" & Range("D" & Rows.Count).End(xlUp).Row & ":E" & Range("E" & Rows.Count).End(xlUp).Row)), vbLf)
        Set oMail = oApp.CreateItem(0)
        With oMail
            .To = Range("A" & X).Text
            .cc = Range("E1").Text
            .Subject = Range("E2").Text
            .Body = MyBody
            .Attachments.Add Range("E3").Text
            .Display
            If UCase(Range("E4").Text) = "SEND" Then
                .Send
            ElseIf UCase(Range("E4").Text) = "DRAFT" Then
                .Save
                .Close False
            Else
                MsgBox "You need to choose Draft or Send in cell E4"
                End
            End If
        End With
        Application.ScreenUpdating = True
        Set oMail = Nothing
    Next
    Set oApp = Nothing
End Sub

收件人进入 A 列，名字进入 B 列，任何 CC 进入 E1，主题进入 E2，任何附件链接进入 E3，E4 是草稿或发送以创建草稿或发送。

然后消息正文在 E5 中尽可能向下，每行将由双回车分隔。在您使用包含大于和小于符号的名字的任何地方，代码都会将其替换为 B 列中该人的名字。

然后直接输入您想要的签名并将“签名”放在它开头旁边的 D 列中，这将由单个回车分隔。