在实际的工作当中，有许多小规模的单位总是采用EXCEL来做员工工资，因为EXCEL中有许多公式可以用，只填入当月变动的项目，扣税、最终实发工资等项目就自动计算出来了。做出工资了有好多单位财务人员不得不打印出来裁成小纸条再发给各员工，这样在人力和时间成本上都耗费不少。最近我单位财务人员对技术部门提出了这个问题，我们考虑后决定采用最简单最环保的方法：利用VBA在EXCEL中结合JMAIL组件做员工工资条发送系统，EXCEL工作簿中至少有两张表，一张是工资表，另一张是员工姓名与E-MAIL对照表。
发送到E-MAIL中的工资表可以有有两种形式：HTML形式；附件形式。因为有时候财务想把EXCEL另存成一个文件，里面只有对应员工的工资和一些备注，这种形式在另一篇文件中介绍，本文先介绍E-MAIL的内容为HTML形式的VBA方法。
该方法的原理：
A)用VBA在EXCEL中先把每位员工的工资做成HTML和表格，再加上表头，就是一位员工完整的工资。
B)找到每位员工对应的E-MAIL(员工的E-MAIL列表在EXCEL的另一张SHEET表中)。
C)调用JMAIL组件发送给每位员工，如果你愿意，还可以要求员工给你一张收条。
方法很简单，月底做完工资，财务工作人员执行一下宏，就OK了。不过在写宏的时候有一些要注意的问题，下面列出宏的所有源码，重点部分做出标识。
图例：
发送前在EXCEL中的工资表(部分)： 
发送后E-MAIL中的工资表(部分)： 
宏名是SendWage可以在单独的模块，也可以在ThisWorkbook中。
Sub SendWage() ‘主程序
‘变量定义部分
Dim strTemp$, I%, J%, rowNum%, colNum%,
cName$, strEmail$, headNo%
Dim strHead1$, strHead2, strContent$,
strTail$, strEtitle$, strEcontent$
Dim cellWidth As Long
headNo = 4 ‘指表头部分，真正的员工工资是从第5行开始
Sheets("sheet1").Select ‘选中工资表，默认是sheet1
'计算出行数，即有多少员工
I = headNo + 1
strTemp = Trim(Sheets("sheet1").Cells(I, 1).Value)
While Len(strTemp) > 0
I = I + 1
strTemp = Trim(Sheets("sheet1").Cells(I, 1).Value)
Wend
rowNum = I – 1
'计算出列数，即表头有多少项目
I = 1
strTemp = Trim(Sheets("sheet1").Cells(headNo, I).Value)
While Len(strTemp) > 0 Or Len(Trim(Sheets("sheet1")
.Cells(headNo - 1, I).Value)) > 0
I = I + 1
strTemp = Trim(Sheets("sheet1").Cells(4, I).Value)
cellWidth = cellWidth + Sheets("sheet1").Cells(4, I).Width
Wend
colNum = I – 1
'做表头部分，针对前四行做出表头部分，赋值给一个变量，所有员工共用
strHead1 = "<table border =1 width=" & cellWidth & ">"
strHead2 = "<tr>"
For I = 1 To colNum
strTemp = Trim(Cells(headNo, I).Value)
If Len(strTemp) = 0 Then
strHead2 = strHead2 & "<td width=" & Trim(str(Cells(headNo - 1, I)
.Width)) & ">" & Trim(Cells(headNo - 1, I).Value) & "</td>"
Else
strHead2 = strHead2 & "<td width=" & Trim(str(Cells(headNo - 1, I)
.Width)) & ">" & Trim(Cells(headNo, I).Value) & "</td>"
End If
Next
strHead2 = strHead2 & "</tr>"
'做表尾部分
strTail = "</table>"
'从第一个名字处开始发送
For I = headNo + 1 To rowNum
‘一定要用Replace函数把cName名字中的空格去掉，
因为有两个的员工有时候财务人员为了跟整齐，
容易写成“李 四”，这样可能会查找不到
cName = Trim(Replace(Cells(I, 2).Value, " ", ""))
strEmail = findEmail(cName) ‘调用函数findEmail找到员工对应的E-MAIL
Sheets("sheet1").Select
strContent = "<tr>"
For J = 1 To colNum
strContent = strContent & "<td width=" & Trim(str(Cells(I, J).
Width)) & ">" & Trim(Cells(I, J).Value) & Trim(str(Cells(I, J)
.Comment.Text)) & "</td>"
Next
strContent = strContent & "</tr>"
‘E-MAIL的标题
strEtitle = cName & Format(Trim(Cells(2, 1).Value), "yyyy年mm月") & "工资条"
‘E-MAIL的正文
strEcontent = strtitle & "<br>" & strHead1 & strHead2 & strContent & strTail
‘调用JmailSend 函数发送E-MAIL
strTemp = JmailSend(strEtitle, strEcontent,
True, HtmlBody,strEmail, "zhm@chinaccm.com",
"gz", "192.168.10.2", "", "")
Next
End Sub |
函数findEmail，在另一张表中遍历找到员工对应的E-MAIL
Function findEmail(ByVal cName As String) As String
Dim I%, strTemp$
Sheets("email").Select
‘对应的所有员工E-MAIL列表，只有两列，名字和E-MAIL
I = 1
strTemp = Trim(Cells(I, 1).Value)
While Len(strTemp) > 0
I = I + 1
strTemp = Trim(Cells(I, 1).Value)
If strTemp = cName Then
findEmail = Trim(Cells(I, 2).Value)
Exit Function
End If
Wend
End Function |
函数JmailSend，是调用了JMAIL组件
在EXCEL的菜单“工具”---“引用”对话框中选“JMAIL 4.0 LIBRARY”，就添加了引用。如果没有这一项，请安装JMail44_free，这是一个FREE的版本。
Function JmailSend(attachFile, Subject,
Body, isHtml, HtmlBody, MailTo, From,
FromName, Smtp, Username, Password)
'=================================================
'函数名：JmailSend
'作 用：用Jmail发送邮件
'参 数：Subject 邮件标题
' Body 邮件内容
' Body 邮件内容
' isHtml 是否发送Html格式邮件 (true 是)
' HtmlBody Html格式邮件内容
' MailTo 收件人Email
' From 发件人Email
' FromName 发件人姓名
' Smtp smtp服务器
' Username 邮箱用户名
' Password 邮箱密码
'返回值：JmailSend="N" 发送失败 JmailSend="Y" 发送成功
'~~~~~~~~~~suercool~~~~~
'=================================================
Dim JmailMsg
'Set JmailMsg = server.CreateObject("jmail.message")
Set JmailMsg = New jmail.Message
JmailMsg.MailServerUserName = Username‘如果是在局域网中可以不要验证
JmailMsg.MailServerPassWord = Password
JmailMsg.AddRecipient MailTo
JmailMsg.From = From
JmailMsg.FromName = FromName
JmailMsg.Charset = "gb2312"
JmailMsg.ContentType = "text/html"
JmailMsg.Priority = 1
JmailMsg.Logging = True
JmailMsg.Silent = True
JmailMsg.Subject = Subject
JmailMsg.Body = Body
JmailMsg.AddAttachment = attachFile
If isHtml = True Then JmailMsg.HtmlBody = HtmlBody
If Not JmailMsg.Send(Smtp) Then
JmailSend = "N"
Else
JmailSend = "Y"
End If
JmailMsg.Close
Set JmailMsg = Nothing
'MsgBox (JmailSend) ‘测试时可以用
End Function |
至此，完整的程序已介绍完毕。其实引发开去，如果有类似工作性质的东东，都可以用此种方法将各员工的记录发送到各员工的信箱中，节约了纸张，节省了人力和时间，何乐而不为。
利用VBA软件也是绿色环保软件，不用安装，代码随着文件走，没有在硬盘上造成垃圾，窃以为不错，不敢独享，献丑与大家共享。如果大家有什么疑问，可以发信到henrryzhang@mail.china.com，共同讨论求进步。
