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

最新推荐文章于 2024-03-01 11:45:22 发布

提出问题解决问题

最新推荐文章于 2024-03-01 11:45:22 发布

阅读量1w

点赞数 5

分类专栏：办公

本文链接：https://blog.csdn.net/networkhunter/article/details/81001734

版权

办公专栏收录该内容

6 篇文章

订阅专栏

本文介绍了一种利用Excel宏功能批量发送工资单的方法，通过简单的VBA编程实现自动发送个性化工资单到每个员工的邮箱。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

公司的财务每次发工资的时候都是，每个人的单独发一次工资条，如果是小公司人不多，这个还可以。如果人数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 = "xxx@xxx.com" '发件人  财务的邮箱
    
    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") = "xxx@xxx.com" '用户名  修改为财务的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 = " <tr>您好！<br> 以下是您" + sFile1 + "，请查收！</tr> "  //会显示一下是您6月份的工资单，请查收
        
        For A = 1 To endColumnNo
            '含有字母大写X的列不发送，先把表头打印，在把对应员工的一行保存在变量里，构造了一个简单html的表格。
            If Application.WorksheetFunction.CountIf(Cells(1, A), "*X*") = 0 Then
                sFile = sFile + "<table border=1> <tr>  <td width='150' height='25'> " + Cells(1, A).Text + " </td> <td  width='230' height='25'> " + Cells(rowCount, A).Text + "</td> </table>"
            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

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