使用Excel和OutLook实现自动发送邮件

　

自动发邮件

#问题的产生

我们在平时工作中可能会遇到要批量发送邮件的工作，例如财务部根据每个人的工资情况发放工资条到个人的邮箱，因为邮件因人而异，所以需要完成大量而细致的工作，工作繁琐，重复劳动多，非常适合批量发送。因此研究如何利用电子表格建立数据，利用OutLook来发送这些数据，要求发送具有表格格式的工资条。

#使用工具

excel及VBA技术

OutLook

#数据准备

新建一个工作簿，保存为.xlsm(启用宏的文档)格式

建立两张表，第一张表数据为工资数据，我们用一个测试数据来建立。

序号	员工编号	姓名	所属部门	基本工资	岗位工资	绩效工资	补贴	其他	邮件号
1	M1001	王小明	办公室	16200	3000	4860	1215	150	1
2	M1002	郭海英	办公室	15120	3000	4536	1134	150	1
3	M1003	史彩霞	办公室	14500	3000	4350	1010	150	1
4	M1004	徐桂玲	销售部	19300	3200	5790	1500	150	1
5	M1005	周君正	销售部	18000	3200	5400	1350	150	2
6	M1006	胡德成	销售部	16300	3200	4890	1200	150	2
7	M1007	常青	销售部	16200	3200	4860	1215	150	2
8	M1008	龙虎清	技术部	18500	3500	5550	1350	150	3
9	M1009	马文瓶	技术部	18500	3500	5550	1350	150	3
10	M1010	丁静雯	技术部	17800	3500	5340	1335	150	3
11	M1011	田保东	技术部	16300	3500	4890	1200	150	4
12	M1012	宋桂英	技术部	16300	3500	4890	1200	150	4
13	M1013	张玉萍	生产部	12000	2800	3600	900	150	4
14	M1014	戴雪英	生产部	10500	2800	3150	800	150	5
15	M1015	李扬	生产部	10300	2800	3090	800	150	5
16	M1016	王剑飞	生产部	9800	2800	2940	735	150	5
17	M1017	邱方明	生产部	8700	2800	2610	650	150	6
18	M1018	刘小青	生产部	8500	2800	2550	630	150	6
19	M1019	马克萍	生产部	8300	2800	2490	620	150	6

第2张表是邮件地址表，我们用下面的测试数据

邮件号	收件人地址	邮件主题	邮件内容	粘贴附件
1	[email protected]	自动发工资条测试
2	[email protected]	自动发工资条测试
3	[email protected]	自动发工资条测试
4	[email protected]	自动发工资条测试
5	[email protected]	自动发工资条测试
6	[email protected]	自动发工资条测试

[email protected]是假的

其中邮件号是两张表关联的列，用于指示相关的邮件地址

#开始准备工资数据

#准备邮箱信息

新建一个表，把邮箱的测试信息复制后粘贴进去。

#录入VBA代码

按 Alt + F11 组合键，弹出VBA代码编辑器，在当前Excel的文件目录下点击鼠标左键，弹出选择框，选择插入，选取点击模块。

粘贴下列代码

Sub getEmail_Info()
    Dim uRange As Range
    Dim uR As Range
    Dim uRg As Range
    Dim uNum As String
    Dim uI As integer
    Dim uRow As Integer
    Dim uCol As Integer
    Dim Receiver As String
    Dim subjectText As String
    Dim attachedObject As String
    DIM uEmailNoCol as String
    Dim uStr as string


    '查找用Range对象的Find方法，返回Rang对象，然后再取Range对象的Row属性或Column属性返回行或列。
    '要注意的是Find方法可能会返回Nothing，要先检查一下，否则后出错。
    'Rows("8:8").Select

    Sheets(1).Activate
    Set uR = Sheets(1).Range("A1:ZZ1").Find("邮件号")
    Set uRange = uR

    If Not uR Is Nothing Then
        uRow = uR.Row + 1  '返回所在的行
        uCol = uR.Column   '返回所在的列
    End If

    '获得单元格的值
    uNum = Sheets(1).Cells(uRow, uCol)

    '对邮件号所在的列进行循环 ? Asc("A")
    Set uRg = Sheets(1).Columns(uCol)
    uEmailNoCol = Chr(Asc("A") + uCol - 2)  '不发邮件号所在列

    For uI = 2 To 32767
      If uRg.Cells(uI).Value <> uNum Then
        'Set uRange = Range("A" & uRow & ":" & Chr(Asc("A") + uCol - 2) & uI - 1)
        uStr = "工资表!A1:" & uEmailNoCol & "1,工资表!A" & uRow & ":" & uEmailNoCol & uI - 1
        Set uRange = Range(uStr)


        '获得邮件的地址、
        Set uR = Sheets("邮件地址表").Columns(1).Find(What:=uNum, lookat:=xlPart)
        If Not uR Is Nothing Then
            Receiver = Sheets("邮件地址表").Cells(uR.Row, uR.Column + 1).Value
            SubjectText = Sheets("邮件地址表").Cells(uR.Row, uR.Column + 2).Value
            AttachedObject = ""

            If SendEmail(Receiver, SubjectText, uRange, AttachedObject) = False Then
                Exit For
            End If
        End If

        uNum = uRg.Cells(uI, 1).Value
        uRow = uI
        If uRg.Cells(uI).Value = "" Then
          Exit For
        End If
      End If
    Next
End Sub
Public Function SendEmail(Receiver As String, SubjectText As String, uRange As Range, AttachedObject As String) As Boolean

    Dim OutlookAPP As Outlook.Application
    Dim OutlookItem As Outlook.MailItem

    Set OutlookApp = New Outlook.Application
    Set OutlookItem = OutlookApp.CreateItem(olMailItem)

On ERROR GoTo SendEmail_Error
    With OutlookItem
        .To = Receiver   '收件人地址
        .CC = ""
        .BCC = ""
        .Subject = SubjectText '邮件主题
        .BodyFormat = Outlook.OlBodyFormat.olformatHTML
        .HTMLBody = RangetoHTML(uRange)     'HTML的内容
        '.Body = "" '邮件内容
        .display
        If AttachedObject <> "" Then
          .Attachments.Add AttachedObject '粘贴附件
        End If
        .Send '发送邮件
    End With
    SendEmail = True

SendEmail_Exit:
    Exit Function

SendEmail_Error:
    SendEmail = False
    MsgBox Err.Description
    Resume SendEmail_Exit
End Function


Public Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    rng.Copy

    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add(SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")

    TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

#添加OutLook的引用

代码和内容都设定好了，还需添加引用，打开编辑器的工具-引用，选择Outlook插件即可，如图所示

#配置OutLook

在OutLook2016上配置默认邮箱，注意sina邮箱的配置较为容易，直接使用邮箱名和密码就好了，网易163和QQ邮箱需要开启pop3和smtp，同时需要启用客户端授权密码，要手机绑定才能配置。

#自动发送邮件

在发送邮件前请先运行OutLook程序，

然后在excel2016上依次点击：视图->宏->查看宏->执行宏（getEmail_Info），即可实现自动发送邮件。

可以在程序中不显示发送过程的窗口。去掉

.Display

即可

下图是在网页上查看接收的邮件的截图：

#结束语

前一个版本需要繁琐的插入空行制作工资条的过程，发现会出现编辑上的错误，现在修改了一下程序，不需要对电子表格进行太多的处理了。

这是一个自动发送邮件的基本测试，当然我们可以依次为基础建立更多更复杂的应用，不仅在excel中，也可以在其它开发工具上实现。

得心应手的工具是我们高效工作的保障，当我们要去砍柴前，就先磨一把锋利的刀吧。

测试前请修改一下邮箱，不要直接用，否则都发到我的邮箱中了

相关阅读

把excel2010绘图工具调出来的教程

在Excel中经常会使用到绘图工具，但可能有些时候手滑点错了，把绘图工具点没了，下面是seo实验室小编带来的关于把excel 2010绘图工具调

excel表格统计个数的方法步骤图

我们在工作中使用excel时，经常会用到统计个数的操作，统计个数的方法有很多种，不妨和小编一起看看以下这种统计个数的方法，或许对你有

Excel2007中工作表基本操作的功能使用

这篇是学习Excel2007系列经验的第二篇经验，具体讲的是Excel中进行工作表的操作，该如何去进行操作的呢?今天，seo实验室小编就教大家在

Windows自动弹出MSN中文网界面解决办法

Windows自动弹出MSN中文网界面解决办法 原因：每当用户连接到网络时，Windows 会向微软的一个域名发送访问请求，访问结果作为网络连接

数据结构之二叉排序树（C语言实现）

一、基本概念 1.二叉排序树 二叉排序树（Binary sort tree，BST），又称为二叉查找树，或者是一棵空树；或者是具有下列性质的二叉树： (1)若