财务希望excel自动发送邮件，从网上找的一些初始代码，做了如下修改：
1.表头和表内容采用动态获取
2.用的是腾讯企业邮箱
3不需要SMTP服务器密码，只需要邮箱密码即可
代码如下，邮箱地址请自己填写
Private Sub CommandButton1_Click()
Dim CDOMail As Object
Dim strPath As String
Dim aData As Variant
Dim i As Long
Dim strURL As String
Dim strFromMail As String
Dim strFromName As String
Dim strPassWord As String
Dim nn As Long
strFromMail = "这里填写你全邮件地址"
strFromName = "这里填写你全邮件地址"
strPassWord = Range("b1").Value
If strPassWord = "****" Or strPassWord = "" Then
MsgBox "未输入邮箱密码"
Exit Sub
End If
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Sheets("Sheet1").Select
aData = Range("a1:c" & Cells(Rows.Count, 1).End(xlUp).Row)
'--------数据装入数组aData
nn = Sheet1.UsedRange.Columns.Count
'获取使用列数
On Error Resume Next
For i = 3 To UBound(aData)
Set CDOMail = CreateObject("CDO.Message")
'--------创建CDO对象
CDOMail.From = strFromMail
'--------发信人的邮箱
CDOMail.To = aData(i, 1)
'--------收信人的邮箱
CDOMail.Subject = aData(i, 2)
'--------邮件的主题
CDOMail.htmlBody = SalaryContext(nn, i)
'--------邮件的内容（Html格式)
'CDOMail.TextBody = aData(i, 3)
'--------邮件的内容（文本格式)
strURL = "http://schemas.microsoft.com/cdo/configuration/"
'--------微软服务器网址
With CDOMail.Configuration.Fields
.Item(strURL & "smtpserver") = "smtp.exmail.qq.com"
'--------SMTP服务器地址
.Item(strURL & "smtpserverport") = 465
'--------SMTP服务器端口
.Item(strURL & "sendusing") = 2
'--------发送端口
.Item(strURL & "smtpauthenticate") = 1
'--------远程服务器验证
.Item(strURL & "sendusername") = strFromName
'--------发送方邮箱名称
.Item(strURL & "sendpassword") = strPassWord
'--------发送方邮件密码
.Item(strURL & "smtpusessl") = True
.Item(strURL & "smtpconnectiontimeout") = 60
'--------设置连接超时（秒）
.Update
End With
CDOMail.Send
'--------发送
If Err.Number = 0 Then
aData(i, 1) = "发送成功"
Else
aData(i, 1) = "发送失败"
End If
Next
Range("c1").Resize(UBound(aData), 1) = aData
Range("c2") = "发送状态"
Range("c1") = ""
'--这里是将结果回写
Set CDOMail = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
MsgBox "您好，发送任务完成。"
End Sub
'工资条表格明细
Function SalaryContext(ByVal allcol As Integer, ByVal Row As Integer) As String
Dim htmlBody, tableHeader, tableBody As String
Dim k As Integer
htmlBody = "<html>" & _
"<head>" & _
"<meta http-equiv=""Content-Type"" contentType=""application/vnd.ms-excel;charset=gb2312"">" & _
" <STYLE type=text/css>" & _
" .sub_title{" & _
" FONT-WEIGHT: bold;" & _
" FONT-SIZE: 4mm;" & _
" VERTICAL-ALIGN: middle;" & _
" TEXT-ALIGN: center" & _
" background-color: #ffff66//" & _
" }"
htmlBody = htmlBody & " .context {" & _
" font-size: 12px;" & _
" BORDER-TOP-WIDTH: 0.6mm;" & _
" PADDING-RIGHT: 1mm;" & _
" PADDING-LEFT: 1mm;" & _
" BORDER-LEFT-WIDTH: 0.6mm;" & _
" BORDER-BOTTOM-WIDTH: 0.6mm;" & _
" PADDING-BOTTOM: 0mm;" & _
" PADDING-TOP: 0mm;" & _
" BORDER-COLLAPSE: collapse;" & _
" BORDER-RIGHT-WIDTH: 0.6mm" & _
" }"
htmlBody = htmlBody & " .context td{" & _
" border:1px solid #009900;" & _
" }" & _
" .page {" & _
" page-break-after: always;" & _
" }" & _
" </STYLE>" & _
"</head><body>Dear " & Range("f" & Row).Value & Chr(13)
htmlBody = htmlBody & "<table class=""context"" borderColor=""#669933"" border=1>"
'MsgBox htmlBody
'表头
tableHeader = "<tr bgcolor=""#FFE66F"">"
For k = 4 To allcol
tableHeader = tableHeader & "<td align=""center"">" & Worksheets("Sheet1").Range(Split(Cells(2, k).Address, "$")(1) & "2").Value & "</td>"
Next
tableHeader = tableHeader & "</tr>"
'MsgBox Worksheets("Sheet1").Range("F" & Row).Value
'表格内容
tableBody = "<tr>"
For k = 4 To allcol
tableBody = tableBody & "<td>" & Worksheets("Sheet1").Range(Split(Cells(2, k).Address, "$")(1) & Row).Value & "</td>"
Next
tableBody = tableBody & "</tr>"
htmlBody = htmlBody & tableHeader & tableBody & "</table></body></html>"
SalaryContext = htmlBody
End Function