VBA 批量发送邮件

1. 布局

2. 代码

前期绑定的话，需要勾选 Microsoft Outlook 16.0 Object Library

Option Explicit

Const SEND_Y As String = "Yes"
Const SEND_N As String = "No"
Const SEND_SELECT_ALL As String = "Select All"
Const SEND_CANCEL_ALL As String = "Cancel All"

Private Sub btnSendMail_Click()
    Dim i, j As Long
    Dim strSub As String
    Dim strBody As String
    Dim strSendFlag As String
    Dim arrFile() As String
    Dim strFile As String
    
    Dim objApp As Object
    Dim objMail As Object
    'Dim objApp As New Outlook.Application
    'Dim objMail As MailItem
    
    Set objApp = CreateObject("Outlook.Application")
    
    
    For i = 4 To Range("B" & Rows.Count).End(xlUp).Row
        strSendFlag = Range("B" & i).Value
        
        If strSendFlag = SEND_Y Then
            Set objMail = objApp.CreateItem(0)
            On Error Resume Next
            With objMail
                .To = Range("C" & i).Value
                .CC = Range("D" & i).Value
                .BCC = Range("E" & i).Value
                .Subject = Range("F" & i).Value
                .HTMLBody = Range("G" & i).Value
                ''''''''''''''''''
                strFile = Range("H" & i).Value
                If strFile <> vbNullString Then
                    arrFile = Split(strFile, vbLf)
                End If
                For j = LBound(arrFile) To UBound(arrFile)
                    .Attachments.Add arrFile(j)
                Next j
                
                
                .Display
                '.Send
            End With
            Set objMail = Nothing
            On Error GoTo 0
        End If
    Next
    
    Set objApp = Nothing
    
    MsgBox "Done."
    
End Sub

Private Sub btnSendFlag_Click()
    Dim i As Long
    Dim strSendFlag As String
    
    Columns("B").ColumnWidth = 10
    
    
    btnSendFlag.Top = Range("B1").Top
    btnSendFlag.Left = Range("B1").Left
    btnSendFlag.Width = Range("B1").Width
    btnSendFlag.Height = Range("B1").Height + Range("B2").Height
    
    
    If btnSendFlag.Caption = SEND_SELECT_ALL Then
        strSendFlag = SEND_Y
        btnSendFlag.Caption = SEND_CANCEL_ALL
    Else
        strSendFlag = SEND_N
        btnSendFlag.Caption = SEND_SELECT_ALL
    End If
   
    For i = 4 To Range("B" & Rows.Count).End(xlUp).Row
        Range("B" & i).Value = strSendFlag
    Next i
    
    
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Column = 2 Then
        If Target.Row >= 4 And Target.Row <= Range("B" & Rows.Count).End(xlUp).Row Then
            If Target.Value = SEND_Y Then
                Target.Value = SEND_N
            Else
                Target.Value = SEND_Y
            End If
        End If
    End If
    
End Sub