Excel VBA開發自動傳送郵件

阿新 • • 發佈：2019-01-16

一、.設定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,寫如下程式碼:

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表格哪一行。

主要程式碼如下:

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表格中的內容如下

Excel VBA開發自動傳送郵件

一、.設定Outlook郵箱帳(略不是本文章的重點) 二、.設定Outlook信任中心如下步驟若沒有做如下操作設定，則Excel VBA呼叫Outlook自動傳送郵件時提示如下 2.1 Outlook->工具->信任中心 2.2 程式設計訪

VBA自動傳送郵件

Sub sendMailforCheck() Dim Subj As String Dim EmailAddr As String, Emailcc As String Dim msg As String Dim attachFileName

windows關機前執行指令碼設定與關機blat自動傳送郵件指令碼模板

1.開始——執行——gpedit.msc2.策略——計算機配置——Windows設定——指令碼（啟動/關機）3.右擊"關機"4.新增——瀏覽：選擇指令碼確定；5.完成設定，重啟測試。注：關機指令碼啟動目錄：C:\Windows\System32\GroupPolicy\Machine\Scripts\Sh

python selenium-7自動傳送郵件

https://jingyan.baidu.com/article/647f0115b78f8d7f2148a8e8.html 1.傳送HTML格式的郵件 import smtplib from email.mime.text import MIMEText from email.header impor

Appium+python 自動傳送郵件(2)

移動端執行完測試case之後，通過郵件自動傳送測試報告。大體流程如下： 1、通過unittest框架的discover()發現所有測試用例 2、使用HTMLTestRunner的run()方法執行測試用例，生成HTML測試報告 3、尋找測試報告目錄下的最新測試報告，返回最新測試報告的路徑 4、將最新測

python 自動傳送郵件報表，正文插入圖片，帶附件

# -*- coding: utf-8 -*- """ Created on Wed Aug 15 17:44:33 2018 @author: cp """ from email.mime.text import MIMEText from email.mime.mul

Linux指令碼編寫程式監控系統資訊並設定報警自動傳送郵件

yum -y install mailx yum -y install sendmail #獲取cpu使用率 cpuUsage=`top -n 1 | awk -F '[ %]+' 'NR==3 {print $3}'` #獲取磁碟使用率 data_nam

Intouch/ifix語音報警系統製作(4-自動傳送郵件提醒)

在近期專案完成後，有遇到情況：類似於語音報警後，中控室人員未及時報告給我們造成了事件的危害升級，以及造成很不好的影響。針對這個情況特此新增語音報警後，自動傳送郵件提醒，完善現有的報警機制。 1.函式編寫（選自網友指令碼） Option Explicit '需要引用 Mi

python的yagmail庫-自動傳送郵件功能

一、yagmail安裝使用pip install yagmail命令安裝。我的環境是python2.7.15，使用pip直接安裝就ok了。二、例項 1、開通SMTP服務檢查使用的郵箱伺

Linux使用mail功能自動傳送郵件程式以及經常遇到的問題

在實現Linux中mail功能自動傳送郵件時，需要傳送中文內容，以及中文主題的郵件。整個實現過程中遇到了三大問題，如下： 1、如何傳送html格式的郵件內容？ 2、如何傳送中文內容的郵件？ 3、如何傳送中文標題的郵件？（在解決這個問題時話費不少時間） 4、傳送的郵件內容以

C#中自動傳送郵件的實現

原始碼： using System; using System.Windows.Forms; using System.Net.Mail; using System.Text.RegularExpressions; namespace 郵件 { public partial clas

python 自動傳送郵件傳送多人、群發、多附件

1、最近公司實現部分資料統計、分析的報表進行每天定時傳送到相關人員的郵箱之中的配置程式碼被人為刪除了，需要重新恢復該功能，由於原先是在linux上使用shell配置傳送，實在是太繁瑣，所以準備使用python來實現該功能，不過發現網上各種文件都是未經過整理，程式碼寫的很不友

c# 自動傳送郵件測試程式碼

using System; using System.Collections.Generic; using System.ComponentModel; using System.Data; using System.Drawing; using System.Linq;

jmeter+ant+jenkins自動化構建成功自動傳送郵件

二、修改build build.xml 檔案內容如下，copy一份進去，相關地址需要修改 <?xml version="1.0" encoding="UTF-8"?> <project name="ant-jmeter-test"

Python使用SMTP自動傳送郵件

連結中的教程介紹了基礎的使用方法，這裡不再重複。這裡主要是介紹使用中碰到的問題下面是我的示例程式 # -*-coding:utf-8 -*- ''' Created on 2016.11.12 Se

SMTP自動傳送郵件功能程式碼

SMTP自動傳送郵件功能我也是跟著各種部落格一步一步搜尋出來的，可能在設定郵箱的時候會有各種問題，請參考我的其他部落格進行設定 https://blog.csdn.net/ly021499/article/details/82423019 https://blog.csdn.net/l

python自動傳送郵件所遇問題集錦

問題一：smtplib.SMTPAuthenticationError: (550, b'\xd3\xc3\xbb\xa7\xce\xde\xc8\xa8\xb5\xc7\xc2\xbd') 因為發件的郵箱伺服器有驗證碼，需要到郵箱中開啟SMTP服務即可。詳情參考：https://jing

CMD Telnet 命令列自動傳送郵件指令碼

定期監控sql server服務執行狀態，如服務停止，則啟動它?這個比較簡單的方法可以實現 net start 服務名稱放到windows的定時執行中就好了如果服務已經啟動則報服務已經啟動以下是監控服務，併發送郵件首先簡單介紹一下SMTP SMTP基本命令

Python--指令碼自動傳送郵件

自動傳送郵件功能是我們經常要用到的，比如每天定時統計報表資訊，然後自動傳送給運營人員，協助運營人員進行業務資料分析。本文是用Python寫的一個自動傳送郵件的指令碼，呼叫函式時，直接把發件人郵箱地址、密碼、收件人郵箱地址、郵件標題、內容等資訊傳遞給函式，即可實現

自用Git提交後自動傳送郵件的指令碼

首先是下載這個post-receive指令碼，我稍微做了些修改，支援在.gitconfig中指定郵件傳送程式(hooks.sendmail)和發件人資訊(hooks.emailfrom)。指令碼下載後放到倉庫的hooks目錄下，並“chmod a+x post-recei

Excel VBA開發自動傳送郵件

相關推薦