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

版权声明:本文为博主原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/networkhunter/article/details/81001734

公司的财务每次发工资的时候都是,每个人的单独发一次工资条,如果是小公司人不多,这个还可以。如果人数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

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


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

展开阅读全文

没有更多推荐了,返回首页