Excel _VBA_Outlook_群发邮件代码

Sub MailToEveryone()
'
' MailToEveryone Macro
' 把工资条通过邮件发给公司的每个人
'
' 快捷键: Ctrl+Shift+E

'要能正确发送并需要对Microseft Outlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem

'取得当前工作表与Cells(1,1)相连的数据区行数
endRowNo = Cells(1, 1).CurrentRegion.Rows.Count - 1


'创建objOutlook应用程序对象
Set objOutlook = New Outlook.Application
Dim body As String
'开始循环发送电子邮件，比如从第一行开始，前十一行是要发送的内容
For rowCount = 1 To endRowNo Step 2
     
     '创建一个objMail为一个邮件对象
     Set objMail = objOutlook.CreateItem(olMailItem)
     With objMail
    ' .FormDescription = "[email protected]"
     .To = Cells(rowCount + 1, 12).Value
     .Subject = "当月工资条"
    ' body = Cells(rowCount, 1).Value & Cells(rowCount, 2).Value & Cells(rowCount, 3).Value & Cells(rowCount, 4).Value & Cells(rowCount, 5).Value & Cells(rowCount, 6).Value & _
    ' Cells(rowCount, 7).Value & Cells(rowCount, 8).Value & Cells(rowCount, 9).Value & Cells(rowCount, 10).Value & Cells(rowCount, 11).Value & vbNewLine & _
    ' Cells(rowCount + 1, 1).Value & Cells(rowCount + 1, 2).Value & Cells(rowCount + 1, 3).Value & Cells(rowCount + 1, 4).Value & Cells(rowCount + 1, 5).Value & Cells(rowCount + 1, 6).Value & _
    ' Cells(rowCount + 1, 7).Value & Cells(rowCount + 1, 8).Value & Cells(rowCount + 1, 9).Value & Cells(rowCount + 1, 10).Value & Cells(rowCount + 1, 11).Value & vbNewLine
      
    ' body = Range(Cells(rowCount, 1), Cells(rowCount + 1, 11)).Value2
      
      body = Cells(rowCount, 1).Value & "：" & Cells(rowCount + 1, 1).Value & vbNewLine & _
      Cells(rowCount, 2).Value & "：" & Cells(rowCount + 1, 2).Value & vbNewLine & _
      Cells(rowCount, 3).Value & "：" & Cells(rowCount + 1, 3).Value & vbNewLine & _
      Cells(rowCount, 4).Value & "：" & Cells(rowCount + 1, 4).Value & vbNewLine & _
      Cells(rowCount, 5).Value & "：" & Cells(rowCount + 1, 5).Value & vbNewLine & _
      Cells(rowCount, 6).Value & "：" & Cells(rowCount + 1, 6).Value & vbNewLine & _
      Cells(rowCount, 7).Value & "：" & Cells(rowCount + 1, 7).Value & vbNewLine & _
      Cells(rowCount, 8).Value & "：" & Cells(rowCount + 1, 8).Value & vbNewLine & _
      Cells(rowCount, 9).Value & "：" & Cells(rowCount + 1, 9).Value & vbNewLine & _
      Cells(rowCount, 10).Value & "：" & Cells(rowCount + 1, 10).Value & vbNewLine & _
      Cells(rowCount, 11).Value & "：" & Cells(rowCount + 1, 11).Value & vbNewLine


     .body = body
     .Send
     End With
     Set objMail = Nothing
Next

Set objOutlook = Nothing


End Sub