利用VBA批量发送Excel中工资单邮件

代码如下

Sub send()
On Error Resume Next
    Dim rowCount, endRowNo, endColumnNo, sFile$, sFile1$, A&, B&
    Dim objOutlook As Object
    'Dim objMail As MailItem
    
    '取得当前工作表格的行数和列数以
    endRowNo = ActiveSheet.UsedRange.Rows.Count
    endColumnNo = ActiveSheet.UsedRange.Columns.Count
    '获取当前sheet的名称
     Sheet = ActiveSheet.Name
    '调用Outlook客户端邮箱
     Set myOlApp = CreateObject("Outlook.Application")
    
     '循环所有行
     For rowCount = 2 To endRowNo
    '新建一封邮件
     Set objMail = myOlApp.CreateItem(olMailItem)
        '正文显示
        sFile = " <tr>您好！<br> 以下是您" + Sheet + "，请查收！</tr><table border=0 style='border-right: 1px solid #a8aeb2;border-bottom: 1px solid #a8aeb2;'> "
        For A = 1 To endColumnNo
            '含有字母大写X的列不发送，先把表头打印，在把对应员工的一行保存在变量里，构造了一个简单html的表格。
            If Application.WorksheetFunction.CountIf(Cells(1, A), "*X*") = 0 Then
                sFile = sFile + " <tr><td width='150' height='25' style='border-top: 1px solid #a8aeb2;border-left: 1px solid #a8aeb2;padding: 3px 7px;'> " + Cells(1, A).Text + " </td> <td  width='230' height='25' style='border-top: 1px solid #a8aeb2;border-left: 1px solid #a8aeb2;padding: 3px 7px;'> " + Cells(rowCount, A).Text + "</td></tr> "
            End If
        Next
          sFile = sFile + "</table>"
        With objMail
            '收件人，在第二列了，如果放到其它列可以修改这里的2数字
            .To = Cells(rowCount, 2)
            '邮件标题
            .Subject = Sheet
            '//正文具体内容
            .HTMLBody = sFile
            '.HTMLBody =RangetoHTML(单元格对象) '//RangetoHTML是自定义函数，见下面。
            .Display '//刷新显示效果的作用
            .send '//发送
        End With
    Next
    Set objMail = Nothing
    MsgBox rowCount - 2 & "个员工的工资单发送成功！"
End Sub