EXECL制作工资表发送给全体员工

制作一个文件

启动VBA代码，源代码如下：

Private Sub CommandButton1_Click()

On Error Resume Next

    Dim rowCount, endRowNo, endColumnNo, sFile$, sFile1$, A&, B&

    Dim objOutlook As Object

    39;Dim objMail As MailItem

    

    39;取得当前工作表格的行数和列数

    endRowNo = ActiveSheet.UsedRange.Rows.Count

    endColumnNo = ActiveSheet.UsedRange.Columns.Count

   

    sFile1 = Range("a1").Value

    39;sFile1 = ActiveSheet.Name 39;获取当前sheet的名称

    39;创建CDO对象

    Set objEmail = CreateObject("CDO.Message")

    

    39;设置发件人，把这个修改为自己的邮件地址

    objEmail.From = "999999@999999.com" 39;发件人  财务的邮箱

    

    objEmail.Subject = sFile1 39;电子邮件主题主题

    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" 39;SMTP服务器地址

    objEmail.Configuration.Fields.Item _

        ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "999999@999999.com" 39;用户名  修改为财务的email地址。

    objEmail.Configuration.Fields.Item _

        ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "999999999" 39;财务邮箱的密码

    objEmail.Configuration.Fields.Item _

        ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 39;明文验证

    objEmail.Configuration.Fields.Item _

        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 39;SMTP端口号

    objEmail.Configuration.Fields.Item _

        ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True  39;启用了ssl协议需要这句，否则不需要

    39;循环所有行

    For rowCount = 4 To endRowNo  39;收件人，在第四行了，如果工资表表体数据开始行次有变，可以修改这里的4数字。

        objEmail.To = Cells(rowCount, 8) 39;收件人，在第八列了，如果放到其它列可以修改这里的8数字。

        

        sFile = " 您好！
以下是您" sFile1 "，请查收！ "  39;会显示一下是您7月份的工资单，请查收

        

        For A = 1 To endColumnNo

            39;含有字母大写X的列不发送，先把表头打印，在把对应员工的一行保存在变量里，构造了一个简单html的表格。

            39;A=1 表示显示起始列，如果要隐藏前面列内容，可以调整A的值

            If Application.WorksheetFunction.CountIf(Cells(1, A), "*X*") = 0 Then

                sFile = sFile "

 

" Cells(3, A).Text "

" Cells(rowCount, A).Text "

"

            End If

        Next

        objEmail.Htmlbody = sFile 39;电子邮件内容

        39;objEmail.Textbody = sFile 39;电子邮件内容

        objEmail.Configuration.Fields.Update

        objEmail.Send 39;将电子邮件发出

        39;MsgBox prompt:="aaaaa", Buttons:=vbOKOnly

    Next

   

    Set objMail = Nothing

    

    MsgBox rowCount - 4 & "个员工的工资单发送成功！"  39;最后弹出对话框提示工资单发送成功了。

End Sub

文件存的格式，可以保留。