Excel宏一键发送工资条

众所周知,发工资的时候每个人都会单独发一次工资条,以前单位人不多,HR手动玩一玩嘛倒也还好,但由于今年公司业务扩张,人数嗖嗖的涨 。还是使用传统方式手动处理就需要浪费非常多的时间了,于是这篇分享就应运而生了。

现假如有这张一张工资条:

首先点击Excel菜单  文件 —-> 选项 —- > 自定义功能区,把 “开发工具” 的复选框选上,没得开发工具是用不了宏写vbs的,如下图:

接下来点击插入按钮,插入一个ActiveX的命令按钮控件。然后在excel空白部分点一下,按钮就绘制出来了,接着双击就可以开始编程了。 处女座同学可以点击设计模式,在按钮上右键属性修改按钮的名称 和 Caption (显示在按钮上的文字),比如改为“发送工资单”或者“老王真帅“等都是可以的,这里推荐设置为老王好帅,因为这里有个隐藏的buff在你使用了一万次之后,说不定我会请你 吃饭~ 扯歪了,上截图:

接下来进入代码编辑界面,长下面这样儿

32位office用户复制Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long),粘贴在第一行。
64位office用户则复制Private Declare PtrSafe Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

接下来复制处理脚本在双击按钮生成的Sub和End Sub之间,点击顶部的小绿三角按钮即可。 代码如下:


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
MsgBox "处理中请稍等"
    On Error Resume Next
    Dim rowCount, endRowNo, endColumnNo, sFile$, sFile1$, A&, B&
    Dim objOutlook As Object
   
    '取得当前工作表格的行数和列数
    endRowNo = ActiveSheet.UsedRange.Rows.Count
    endColumnNo = ActiveSheet.UsedRange.Columns.Count
   
    sFile1 = ActiveSheet.Name
 
    '创建CDO对象
    Set objEmail = CreateObject("CDO.Message")
   
    '设置发件人,张三油箱
    objEmail.From = "zhangsan@abc.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.mxhichina.com" 'SMTP服务器地址
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "zhangsan@abc.com"  '发件用户名,张三邮箱
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "zhangsan123456"  '张三邮箱密码
    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 = 4 To endRowNo
        objEmail.To = Cells(rowCount, 72) '收件人,在最后(72)列
        If Cells(rowCount, 72).Text = "" Then
            Exit For
        End If
       
        sFile = "<p>亲爱的" + Cells(rowCount, 3).Text + " ,您好,卫龙辣条感谢您的辛苦工作!以下是您" + sFile1 + ",请查收!</p><table border=1 style='text-align: center;width: 400px;border-collapse: collapse;'>"
        For A = 1 To endColumnNo
            If A <> 72 Then
                If Cells(3, A).Text <> "" Then
                     If A = 19 Then
                        sFile = sFile + "<tr><td  rowspan='6' style='background-color:yellow'>单位缴纳部分</td><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 19 And 25 > A Then
                        sFile = sFile + "<tr><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A = 25 Then
                        sFile = sFile + "<tr><td  rowspan='4' style='background-color:yellow'>个人缴纳部分</td><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 25 And 29 > A Then
                        sFile = sFile + "<tr><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A = 31 Then
                        sFile = sFile + "<tr><td  rowspan='9' style='background-color:yellow'>本月工资</td><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 31 And 40 > A Then
                        sFile = sFile + "<tr><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A = 40 Then
                        sFile = sFile + "<tr><td rowspan='10' style='background-color:yellow'>扣除</td><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 40 And 50 > A Then
                        sFile = sFile + "<tr><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A = 51 Then
                        sFile = sFile + "<tr><td rowspan='4' style='background-color:yellow'>累计专项扣除</td><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 51 And 55 > A Then
                        sFile = sFile + "<tr><td style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A = 55 Then
                        sFile = sFile + "<tr><td rowspan='6' style='background-color:yellow'>本月附加扣除</td><td style='background-color:#ccffff'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 55 And 61 > A Then
                        sFile = sFile + "<tr><td style='background-color:#ccffff'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A = 61 Then
                        sFile = sFile + "<tr><td rowspan='6' style='background-color:yellow'>累计附加项扣除</td><td style='background-color:#ccffff'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     ElseIf A > 61 And 67 > A Then
                        sFile = sFile + "<tr><td style='background-color:#ccffff'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     Else
                        sFile = sFile + "<tr><td colspan='2' style='background-color:yellow'>" + Cells(3, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                     End If
                Else
                    sFile = sFile + "<tr><td colspan='2' style='background-color:yellow'>" + Cells(2, A).Text + "</td><td colspan='2'>" + Cells(rowCount, A).Text + "</td></tr>"
                End If
            End If
        Next
       
        sFile = sFile + "</table>"
        sFile = sFile + "<br/><br/><br/>"
        sFile = sFile + "祝好!<br/><br/><br/>"
        sFile = sFile + "此工资条仅供员工本人浏览,如有任何疑问,请及时与人力资源部联系!<br/><br/>"
        sFile = sFile + "张三<br/>"
        sFile = sFile + "座机:021-12345678<br/>"
        sFile = sFile + "手机:156-1234-5678<br/>"
        sFile = sFile + "地址: 新疆新疆沙漠第32棵白杨树<br/>"
        sFile = sFile + "邮箱: zhihui.ma@huiyunai.com"

        objEmail.Htmlbody = sFile '电子邮件内容
        objEmail.Configuration.Fields.Update
        objEmail.Send
        Sleep 1000 'ms
    Next
   
    Set objMail = Nothing
   
    MsgBox rowCount - 4 & "个员工的工资单发送成功!"

最后收到邮件部分截图如下:


表格是拼装过合并的, 不需要拼装的同学用下面这段代码替换上面的For循环就好了


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'循环所有行
    For rowCount = 2 To endRowNo
        objEmail.To = Cells(rowCount, 72) '收件人,在第72列了,如果放到其它列可以修改这里的数字。
       
        sFile = " <tr>您好!<br> 以下是您" + sFile1 + ",请查收!</tr> "
       
        For A = 1 To endColumnNo
            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.Configuration.Fields.Update
        objEmail.Send
        Sleep 1000 'ms
    Next

Excel宏一键发送工资条》有2个想法

发表评论

电子邮件地址不会被公开。 必填项已用*标注