前期绑定的话，需要勾选 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