利用Excel批量高速发送电子邮件

利用Excel批量高速发送电子邮件，分两步：

1. 准备待发送的数据：

a.) 打开Excel，新建Book1.xlsx

b.) 填入以下的内容，

第一列：接收人，第二列：邮件标题，第三列：正文，第四列：附件路径

注意：附件路径中能够有中文，可是不能有空格

这里你能够写很多其它内容，每一行作为一封邮件发出。

注意：邮件正文是黑白文本内容，不支持加粗、字体颜色等。（假设你须要支持彩色的邮件，后面将会给出解决的方法）

2. 编写宏发送邮件

a.) Alt + F11 打开宏编辑器，菜单中选：插入->模块

b.) 将以下的代码粘贴到模块代码编辑器中：

‘代码list-1

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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

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 attachement As String)
    Dim objOL As Object
    Dim itmNewMail As Object
    ‘引用Microsoft Outlook 对象
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .subject = subject  ‘主旨
        .body = body   ‘正文本文
        .To = to_who  ‘收件者
        .Attachments.Add attachement ‘附件，假设你不须要发送附件，能够把这一句删掉就可以，Excel中的第四列留空，不能删哦
        .Display  ‘启动Outlook发送窗体
        SetTimer 0, 0, 0, AddressOf WinProcA
    End With
    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

‘批量发送邮件
Sub BatchSendMail()
    Dim rowCount, endRowNo
    endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
    ‘逐行发送邮件
    For rowCount = 1 To endRowNo
        SendMail Cells(rowCount, 1), Cells(rowCount, 2), Cells(rowCount, 3), Cells(rowCount, 4)
    Next
End Sub

终于代码编辑器中的效果例如以下图：

i

为了正确运行代码，你还须要在

菜单中选择： 工具->引用 中的Microseft Outlook X.0 Object Library  勾选上 （X.0是版本，不同机器可能不一样）

c.) 粘贴好代码、勾选上上面的东东后能够发送邮件了，点击上图A红圈所看到的的绿色三角button，会弹出下图所看到的的对话框，点执行，就開始批量发送邮件了。

d.) 假设你想确认你的邮件是否都发出去了，能够去Outlook的“已发送邮件”目录中查看，是否有你希望发出的邮件，假设有，恭喜你，收工~~

---------------------------------------------------------------------

以下解说

1. 怎样发送彩色的邮件

2. 怎样替换正文中的部分内容，比如，每一封邮件中可能最開始的称呼不同，给对方报出的数字不同等

3. 怎样发送多附件

---------------------------------------------------------------------

1. 怎样发送彩色邮件

发送彩色邮件须要两步，

第一步：上面的代码须要改一句（红色加粗文本，body改成HTMLBody）：

‘代码list-2

‘ 发送单个邮件的子程序
Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String)
    Dim objOL As Object
    Dim itmNewMail As Object
    ‘引用Microsoft Outlook 对象
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .subject = subject  ‘主旨
        ‘~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         .HTMLbody = body   ‘正文本文，只这一行跟前面不同，其余都是一样的哦~
               ‘~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        .To = to_who  ‘收件者
        .Attachments.Add attachement ‘附件
        .Display  ‘启动Outlook发送窗体
        SetTimer 0, 0, 0, AddressOf WinProcA 
  End With    Set objOL = Nothing
    Set itmNewMail = NothingEnd Sub

第二步：改动excel第三列（C列）的内容，这须要你懂一点点HTML语言

比如，希望在邮件中将“报税单”三个字变红，加粗，则将第三列的内容改动为：

您好，以下是这一周的<font color="red"><b>报税单</b></font>，…

终于效果如图：

去发件箱里看看效果吧：

注意：在Excel里面编辑正文，进行加粗、加颜色的操作不会生效哦。必须用HTML自己来，sorry哦 不会HTML的朋友能够新浪微博follow我帮忙：@研究员Raywill

2. 怎样替换正文部分内容

分两步：

1. 换Excel内容

2. 换代码

1. 换Excel内容：

将变化的部分用[==xxxx==]这种形式替换掉。注意：中间没有空格。

比如上图，数字[==1==]会被E列的内容替换掉，[==2==]会被F列的内容替换掉，依此类推，假设有很多其它，就加入很多其它列，[==3==], [==4==]等等。

2. 换代码，将 "批量发送邮件"这一段程序全然替换成以下的代码：

‘批量发送邮件
Sub BatchSendMail()
    Dim rowCount, endRowNo
    Dim newBody
    Dim replaceCount, maxReplaceCount
    Dim pattern
    endRowNo = Cells(1, 1).CurrentRegion.Rows.Count

    ‘逐行发送邮件
    For rowCount = 1 To endRowNo
        ‘ 替换当前行模板内容
        maxReplaceCount = 2   ‘ 有几处替换就写几，样例中有两处，就写2
        newBody = Cells(rowCount, 3)

        For replaceCount = 1 To maxReplaceCount
            pattern = "[==" & CStr(replaceCount) & "==]"
            newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount))
        Next
        ‘ 替换好了，发邮件咯！
        SendMail Cells(rowCount, 1), Cells(rowCount, 2), newBody, Cells(rowCount, 4)

    Next
End Sub

注意：上面“maxReplaceCount = 2"这一行代码，2须要改成你自己的值，替换几个地方就写几（新加入了几个列就写几）上面加入了E、F两列，就是2，假设你加入了3处替换（E、F、G列），就写3.

只是，对于须要反复替换的内容，不须要加入新列，比如，《大话西游》在邮件中出现了两次，能够反复使用[==2==]来代表。

3. 怎样发送多附件

在实际应用场景中可能须要发送多封附件，事实上非常easy，将SendMail子程序改动成以下的样子就可以：

‘ 发送单个邮件的子程序
Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String)
    Dim objOL As Object
    Dim itmNewMail As Object
    Dim attaches
    Dim attach

    ‘引用Microsoft Outlook 对象
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .subject = subject  ‘主旨
        .HTMLbody = body   ‘正文本文
        .To = to_who  ‘收件者
        .Display  ‘启动Outlook发送窗体
        attaches = Split(attachement, ";")

        For Each attach In attaches
            If (Len(attach) > 0) Then
                .Attachments.Add attach
            End If
        Next
        SetTimer 0, 0, 0, AddressOf WinProcA
    End With

    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

在Excel的附件列（第三列），多个附件用半角的分号分隔开（是”;"，不是”；“），比如：

c:\doc\毕业证书附件.jpg;c:\doc\校方证明书.docx

终于代码例如以下：

汇总了批量替换、彩色邮件、多附件功能

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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

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 attachement As String)
    Dim objOL As Object
    Dim itmNewMail As Object
    Dim attaches
    Dim attach

    ‘引用Microsoft Outlook 对象
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .subject = subject  ‘主旨
        .HTMLbody = body   ‘正文本文
        .To = to_who  ‘收件者
        .Display  ‘启动Outlook发送窗体
        attaches = Split(attachement, ";")

        For Each attach In attaches
            If (Len(attach) > 0) Then
                .Attachments.Add attach
            End If
        Next
        SetTimer 0, 0, 0, AddressOf WinProcA
    End With

    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

‘批量发送邮件
Sub BatchSendMail()
    Dim rowCount, endRowNo
    Dim newBody
    Dim replaceCount, maxReplaceCount
    Dim pattern
    endRowNo = Cells(1, 1).CurrentRegion.Rows.Count

    ‘逐行发送邮件
    For rowCount = 1 To endRowNo
        ‘ 替换当前行模板内容
        maxReplaceCount = 2   ‘ 有几处替换就写几，样例中有两处，就写2
        newBody = Cells(rowCount, 3)

        For replaceCount = 1 To maxReplaceCount
            pattern = "[==" & CStr(replaceCount) & "==]"
            newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount))
        Next
        ‘ 替换好了，发邮件咯！
        SendMail Cells(rowCount, 1), Cells(rowCount, 2), newBody, Cells(rowCount, 4)

    Next
End Sub

參考文献：

http://www.officefans.net/cdb/viewthread.php?tid=53888

本文发送邮件过程中不会弹出安全提示框，发件速度极快；)

网友反馈：

  • 发件人：angel3814
  • 时间：2013-01-28 10:35:30

您好，经过測试，该方法对于大量发送邮件（大于100封。几十封没有问题。）有一些问题，由于程序必须在建立完毕全部word发送窗体后，才会统一alt+S发送，非常easy造成内存不足，而且，最后的alt+S便不再运行，在实际应用中，我仅仅能再写一个button，每次发送5封，发送完毕计数+5，手工再点；想跟您请教，能否有更好的改进方法？

很感谢angel3814提供的解决方式：

Sub BatchSendMail()
    Dim rowCount, endRowNo, csheet As Worksheet, ssheet As Worksheet, i As Integer, j As Integer
    endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
    ‘逐行发送邮件
    Set csheet = Worksheets("邮件内容")
    Set ssheet = Worksheets("发送")
    i = ssheet.Cells(2, 1).Value
    j = ssheet.Cells(2, 2).Value

    For rowCount = i To j
        SendMail csheet.Cells(rowCount, 1), csheet.Cells(rowCount, 2), csheet.Cells(rowCount, 3), csheet.Cells(rowCount, 4)
    Next
    ssheet.Cells(2, 1).Value = i + 5
    ssheet.Cells(2, 2).Value = j + 5
End Sub

点一次，自己主动+5，再点

之所以用5，是測试发现，10以上，就有非常大几率alt+S事件不生效（可能还是延迟问题？）

====

另外，对于希望批量发送邮件的同学，能够不用把思维局限在Outlook上。假设你知道公司的邮件server的pop3地址，最好还是用命令行工具来实现邮件的批量自己主动发送。

比如：Blat：http://www.blat.net/syntax/syntax.html

先用随意工具将一封封的邮件准备好，保存为一个个文本文件，然后用Blat逐个循环发送就可以。

利用Excel批量高速发送电子邮件,布布扣,bubuko.com

时间： 2024-08-01 22:42:46

利用Excel批量高速发送电子邮件的相关文章

Java网络编程：利用Java mail包发送电子邮件

下面代码是利用Java mail包封装了一个发送邮件的类 import java.io.File; import java.util.ArrayList; import java.util.Date; import java.util.List; import java.util.Properties; import javax.activation.DataHandler; import javax.activation.FileDataSource; import javax.mail.Me

利用OLEDB+SqlClient实现EXCEL批量导入数据

以下是几个自己写的类 /// <summary> /// 取得Excel对象 /// </summary> /// <param name="strConn">OLEDB连接字符串</param> /// <param name="sql">SQL语句</param> /// <returns></returns> public static DataTable GetE

javamail模拟邮箱功能发送电子邮件-中级实战篇【新增附件发送方法】（javamail API电子邮件实例）

引言: 此篇是紧随上篇文章而封装出来的,阅读本篇章建议先阅读上一篇  --> javamail模拟邮箱功能发送电子邮件-基础实战篇 上一篇章简单讲解了javamail发送邮件的基本基础和用到的几个类,并且所有初始化和发送方法都封装在一个类里面(为了代码方便演示),本章节将对各个模块进行拆分和优化,并且引入附件发送的方法 要想邮件发送附件,就要引入两个新类  Multipart 和 BodyPart 两类 Multipart(报文部件容器) 实则为一个报文容器,而邮件消息  Msage 是由各个子

发送电子邮件模块smtplib

功能:smtplib模块是通过邮件服务器发送电子邮件,是smtp客户端的实现,支持邮件格式有:文本.HTML.Image.EXCEL等. 1 #!/usr/bin/env python 2 # coding:UTF-8 3 import smtplib 4 import string 5 host = "smtp.qq.com" #定义smtp主机 6 subject = "Test email from Python" #定义邮件主题 7 to_mail = &q

ASP.NET发送电子邮件

1.补充知识 (1)POP3和SMTP服务器是什么? 简单点来说:POP3 用于接收电子邮件 ,SMTP 用于发送电子邮件. (1)POP3具体指什么? POP3(Post Office Protocol 3)即邮局协议的第3个版本,它是规定个人计算机如何连接到互联网上的邮件服务器进行收发邮件的协议.它是因特网电子邮件的第一个离线协议标准,POP3协议允许用户从服务器上把邮件存储到本地主机(即自己的计算机)上,同时根据客户端的操作删除或保存在邮件服务器上的邮件,而POP3服务器则是遵循POP3协

ASP.NET发送电子邮件(转)

原始地址:http://www.cnblogs.com/ForEvErNoME/archive/2012/06/05/2529259.html(有代码下载,博主真是有操守) 1.补充知识 (1)POP3和SMTP服务器是什么? 简单点来说:POP3 用于接收电子邮件 ,SMTP 用于发送电子邮件. (1)POP3具体指什么? POP3(Post Office Protocol 3)即邮局协议的第3个版本,它是规定个人计算机如何连接到互联网上的邮件服务器进行收发邮件的协议.它是因特网电子邮件的第一

ASP.NET 发送电子邮件简介

1.补充知识 (1)POP3和SMTP服务器是什么? 简单点来说:POP3 用于接收电子邮件 ,SMTP 用于发送电子邮件. (1)POP3具体指什么? POP3(Post Office Protocol 3)即邮局协议的第3个版本,它是规定个人计算机如何连接到互联网上的邮件服务器进行收发邮件的协议.它是因特网电子邮件的第一个离线协议标准,POP3协议允许用户从服务器上把邮件存储到本地主机(即自己的计算机)上,同时根据客户端的操作删除或保存在邮件服务器上的邮件,而POP3服务器则是遵循POP3协

C# Excel 批量上传校验组件

很多开发场景中,都会涉及excel批量导入功能,而导入excel都需要校验数据有效性,字符长度过长,数据类型不匹配,正则校验,连接数据库查询用户名是否合法,等等不一而足:校验之后,还需要对校验不合法的单元格标红..... 你还在为这些烦恼吗? 现在可以不必了,本组件对常用校验做成配置,把正确的数据和错误的数据奉送到你面前,你只需要轻轻东东手配配xml,校验即可完成: 本组件可以学到:面向对象,nopi,缓存依赖....... 本组件已上线运行! 另附组件化培训内部资料!!!! 全是干货!!!!

利用Excel漏洞来破解Excel保护工作表密码

本次实验是利用Excel改后辍成为压缩文件的漏洞来破解Excel保护工作表密码 首先我们建立一个Excel表格然后设置Excel保护工作表密码并另存为 确定密码已经生效 重命名Excel文件后辍.zip 解压已经改好后辍的Excel文件 解压好后会出现4个文件 打开xl后会看到worksheet文件夹 打开后会开到sheet1.xml就是我们设置保护密码的Excel的第一页 使用Adobe Dreamweavr来破解密码 打开Adobe Dreamweavr并且打开sheet1.xml文件 找到