excel 一键给公司所有员工发送工资单 vba代码

公司的财务每次发工资的时候都是，每个人的单独发一次工资条，如果是小公司人不多，这个还可以。如果人数50以上达到100这个需要浪费非常多的时间。

假如有如下这样一份工资单，当然工资单是虚构的。

首先点击excel问菜单  文件 -----> 选项----->自定义功能区----->将 “开发工具” 的复选框选上。

这样之后在菜单栏就会出现 开发工具 一项了。

点击上图中的插入按钮，插入一个ActiveX的按钮控件。然后在excel上拖拽，按钮就绘制在excel上了，点击设计模式，在按钮上右键属性修改按钮的名称 和 Caption （显示在按钮上的文字） 这里可以改为 发送工资单 字样。

我将这个按钮放在了表格的最后一列的后边。

器件需要将excel保存为xlsm格式，否则提示不能使用宏。

接下来给按钮添加代码，实现点击按钮给没个员工发送一条工资单的事情。

按钮的设计模式 鼠标右键 ----> 查看代码。

进入如下的代码编辑界面

在上边两个下拉框中选择按钮名称（CommandButton1，其实可以改成更好的名字例如 sendSalaryButton，因为是一个简单的小程序就偷懒了），和按钮的事件，这里选的是click.  之后向下边自动生成的脚本函数中填入代码

Private Sub CommandButton1_Click()
   
    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
   
    sFile1 = ActiveSheet.Name //获取当前sheet的名称

    '创建CDO对象
    Set objEmail = CreateObject("CDO.Message")
    
    '设置发件人，张姐把这个修改为自己的邮件地址
    objEmail.From = "[email protected]" '发件人  财务的邮箱
    
    objEmail.Subject = sFile1 '电子邮件主题主题

    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.exmail.qq.com" 'SMTP服务器地址
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]" '用户名  修改为财务的email地址。
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" '财务邮箱的密码
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 '明文验证
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'SMTP端口号
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True  '启用了ssl协议需要这句，否则不需要


    '循环所有行
    For rowCount = 2 To endRowNo
        objEmail.To = Cells(rowCount, 2) '收件人，在第二列了，如果放到其它列可以修改这里的2数字。
        
        sFile = " 您好！
 以下是您" + sFile1 + "，请查收！ "  //会显示一下是您6月份的工资单，请查收
        
        For A = 1 To endColumnNo
            '含有字母大写X的列不发送，先把表头打印，在把对应员工的一行保存在变量里，构造了一个简单html的表格。
            If Application.WorksheetFunction.CountIf(Cells(1, A), "*X*") = 0 Then
                sFile = sFile + "
 
  
 " + Cells(1, A).Text + " 
 
 " + Cells(rowCount, A).Text + "
 
"
            End If
        Next
        objEmail.Htmlbody = sFile '电子邮件内容
        'objEmail.Textbody = sFile '电子邮件内容
        objEmail.Configuration.Fields.Update
        objEmail.Send //将电子邮件发出
        'MsgBox prompt:="aaaaa", Buttons:=vbOKOnly
    Next
   
    Set objMail = Nothing
    
    MsgBox rowCount - 2 & "个员工的工资单发送成功！"  //最后弹出对话框提示工资单发送成功了。
    
End Sub

程序编写完毕，点击按钮测试效果。

每个人的邮箱里都会收到如上所示工资单。如果要让工资单的展示效果更加好看，可以调整程序中的html代码部分，可以改变颜色边框粗细等等。