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

         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

      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