您的位置:首页 > 编程语言 > VB

Excel VBA开发自动发送邮件

2018-01-20 22:42 1086 查看
转自:http://blog.csdn.net/chenxianping/article/details/70821116

一、.设置Outlook邮箱帐(略不是本文章的重点)

二、.设置Outlook信任中心如下步骤

        若没有做如下操作设置,则Excel VBA调用Outlook自动发送邮件时提示如下



2.1 Outlook->工具->信任中心



2.2 编程访问->选中”从不向我发出可疑活动警告(不推荐)“,注意:建议使用Excel VBA自动发送邮件启用该功能



三、启用Excel 宏

3.1 启用宏操作如下:

打开Excel点击Office按钮->Excel选项,如下图



选择”Excel 选项“窗体中左边的”信任中心“->信任中心设置,如下图:



在”信任中心“窗体中->宏设置,选如下图二个选项



然后关闭Excel重新打开就可以启用宏和VBA编程开发了。

四、Excel VBA开发

4.1 创建模类:clsModel,写如下代码:

[vb] view
plain copy

Public Declare Function SetTimer Lib "user32" _  

        (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long  

Public Declare Function KillTimer Lib "user32" _  

        (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long  

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  

Sub AutoMail()  

    GB_EMPSALARY.Show  

End Sub  

  

'Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long  

'    KillTimer 0, idEvent  

'    DoEvents  

'    Sleep 100  

'    '使用Alt+S发送邮件,这是本文的关键之处,免安全提示自动发送邮件全靠它了  

'    Application.SendKeys "%s"  

'End Function  

  

' 发送单个邮件的子程序  

Sub SendMail(ByVal to_who As String, ByVal SubJect As String, ByVal body As String, ByVal cell As String)  

    Dim objOL As Object  

    Dim itmNewMail As Object  

    '引用Microsoft Outlook 对象  

    Set objOL = CreateObject("Outlook.Application")  

    Set itmNewMail = objOL.CreateItem(olMailItem)  

    On Error GoTo Err_Handle  

      

    With itmNewMail  

        .SubJect = SubJect  '主旨  

        .htmlBody = body    '正文本文  

        '.body = body   '正文本文  

        .To = to_who  '收件者  

        '.Attachments.Add attachement '附件,如果你不需要发送附件,可以把这一句删掉即可,Excel中的第四列留空,不能删哦  

        .Display  '启动Outlook发送窗口  

        'SetTimer 0, 0, 0, AddressOf WinProcA  

        .Send  

        'Application.Wait (Now + TimeValue("0:00:03"))  

        'Application.SendKeys "%s"  

    End With  

    Worksheets("Sheet1").Range(cell).Value = "Y"  

    Set objOL = Nothing  

    Set itmNewMail = Nothing  

Err_Handle:  

    Set objOL = Nothing  

    Set itmNewMail = Nothing  

    On Error Resume Next  

End Sub  

4.2 创建自动发送邮件界面,方便用户可以看到操作Excel表格哪一行。



主要代码如下:

[vb] view
plain copy

Private Sub butSend_Click()  

    On Error Resume Next  

    Dim i As Integer  

      

    Dim EmpName, eMail, mailSubJect, mailBody, cell, sendFlag As String  

      

      

    i = CInt(txtStartRow.Text)  

    If (i < 3) Then  

        i = 3  

    End If  

    '邮箱主题  

        mailSubJect = "某某公司" & Worksheets("Sheet1").Range("C1").Value & "工资条"  

    '员工姓名  

    EmpName = Worksheets("Sheet1").Range("E" & i).Value  

    '员工姓名为空退出停止发送邮件  

    Do While EmpName <> ""  

        '是否发送邮件标志位  

        sendFlag = Worksheets("Sheet1").Range("A" & i).Value  

        '邮箱地址  

        eMail = Worksheets("Sheet1").Range("AH" & i).Value  

        '邮件是否发关,邮箱地址是否为空  

        If (sendFlag <> "Y" And eMail <> "") Then  

           '邮箱内容  

           mailBody = SalaryContext(EmpName, i)  

           '是否发送标志单元格  

           cell = "A" & i  

           SendMail eMail, mailSubJect, mailBody, cell  

        End If  

        i = i + 1  

        '获得下一行的员工姓名  

        EmpName = Worksheets("Sheet1").Range("E" & i).Value  

        DoEvents  

        Sleep 300  

        txtSend.Text = i  

    Loop  

End Sub  

'工资条表格明细  

Function SalaryContext(ByVal EmpName As String, ByVal Row As Integer) As String  

    Dim htmlBody, tableHeader, tableBody As String  

    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 " & EmpName & Chr(13)  

      

    htmlBody = htmlBody & "<table class=""context"" borderColor=""#669933"" border=1>"  

    'MsgBox htmlBody  

    '表头  

    tableHeader = "<tr bgcolor=""#FFE66F""><td align=""center"">固定工<br>资基准</td>" & _  

        "<td align=""center"">浮动绩<br>效基准</td><td align=""center"">应勤<br>时数</td>" & _  

        "<td align=""right"">实际<br>出勤</td><td align=""center"">节<br>假日</td><td align=""center"">考核<br>系数</td>" & _  

        "<td align=""center"">固定<br>工资</td><td align=""center"">浮动<br>绩效</td><td align=""center"">外宿<br>补贴</td>" & _  

        "<td align=""right"">伙食&补贴</td><td align=""center"">奖金</td><td align=""center"">提成</td>" & _  

        "<td align=""right"">补贴</td><td align=""center"">补发</td><td align=""center"">其他<br>补贴</td>" & _  

        "<td align=""right"">应发<br>合计</td><td align=""center"">迟到</td><td align=""center"">伙食</td>" & _  

        "<td align=""right"">社保</td><td align=""center"">公<br>积金</td><td align=""center"">房租</td>" & _  

        "<td align=""right"">水电</td><td align=""center"">个税</td><td align=""center"">话费</td>" & _  

        "<td align=""right"">代扣学费</td><td align=""center"">其他</td><td align=""center"">代扣<br>合计</td>" & _  

        "<td align=""right"">实发工资</td></tr>"  

   'MsgBox Worksheets("Sheet1").Range("F" & i).Value  

   '表格内容  

   tableBody = "<tr>" & _  

        "<td>" & Worksheets("Sheet1").Range("F" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("G" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("H" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("I" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("J" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("K" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("L" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("M" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("N" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("O" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("P" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("Q" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("R" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("S" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("T" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("U" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("V" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("W" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("X" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("Y" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("Z" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("AA" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("AB" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("AC" & Row).Value & "</td>"  

  

   tableBody = tableBody & "<td>" & Worksheets("Sheet1").Range("AD" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("AE" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("AF" & Row).Value & "</td>" & _  

        "<td>" & Worksheets("Sheet1").Range("AG" & Row).Value & "</td>" & _  

        "</tr>"  

  

   'MsgBox tableBody  

      

   htmlBody = htmlBody & tableHeader & tableBody & "</table></body></html>"  

     

   SalaryContext = htmlBody  

End Function  

Excel表格中的内容如下

内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: