|
推送邮件表格不显示_Excel VBA 实现自动发送邮件 目录 1. 项目准备 2. Excel VBA 工具引用 3. 邮件发送的基础代码 4. 收件人管理 5. 附件管理 6. 邮件正文图片添加的方法 7. 邮件正文表格添加的方法 8. 全功能代码 1：项目准备 启用宏的工作簿：新建一个Excel，另存为.xlsm格式 Outlook配置：Outlook中正确配置发信人的邮箱信息，否则无法实现邮件发送 （Outlook根据版本不同，配置的方法有细微不同，建议网络搜索学习） 备注：Outlook和 Excel 都是Microsoft Office套件里的应用。 2：Excel VBA 工具引用 工具引用：Microsoft Outlook 16.0 Object Library （根据Outlook版本不同，会有细微差别） ———————————————— 版权声明：本文为CSDN博主「sadstershi」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。 原文链接：https://blog.csdn.net/weixin_34795681/article/details/112570278 引用OutLook库 3：邮件发送基础实例 '工具->引用->Microsoft Outlook 16.0 Object Library '或者 Set Mail = CreateObject("Outlook.Application") Sub SendEmail() Dim Mail As Outlook.Application Set Mail = New Outlook.Application Dim objMail As Outlook.MailItem Set objMail = Mail.CreateItem(olMailItem) With objMail .Subject = "My Test Mail" '主题 .To = "xxxxxx@outlook.com" '收件人 .CC = "xxxxx@hotmail.com" '抄送 .BCC = "xxxxx@sina.cn" '密送 .BodyFormat = olFormatHTML .HTMLBody = "<h2>My First Mail</h2>" '正文 .Attachments.Add "D:RunLog.txt" '附件 .Send '执行发送 End With End Sub <如代码里注释说明一样，对于Outlook模块的引用，可以用CreateObject的方式实现，这样不用在菜单里进行引用操作，但该方法会使代码编辑缺少必要的提示> 代码部分与实际邮件部分的对应关系 代码中缺少发件人信息，是因为该程序调用的是Outlook程序，正常使用中的Outlook，是配置有发件人信息的。其它的基本与实际E-mail里的操作或填写内容一致。 Bodyformat： 正文文本格式决定了用于显示消息文本的标准。Microsoft outlook 提供三种正文文本格式选项: 纯文本、富文本(rtf)和html。当 bodyformat 属性从 rtf 切换到 html 时，所有文本格式都将丢失，反之亦然。 BodyFormat值设置 名称 值 说明 olFormatHTML 2 HTML格式 olFormatPlain 1 纯文本格式 olFormatRichText 3 RTF格式 olFormatUnspecified 0 未指定的格式 对于正文内容和格式较为复杂的Mail，bodyformat建议设置为HTML，对于简单句的Mail，从简单的角度出发，设置为纯文本较为方便些。 4：收件人管理 参见基础代码，收件人，抄送，密送，三类收件人都是代码写死的，这样不利于后期的收件人管理，增加或删除名单都会涉及代码的修改，十分麻烦的。 .To = "xxxxxx@outlook.com" '收件人 .CC = "xxxxx@hotmail.com" '抄送 .BCC = "xxxxx@sina.cn" '密送 解决该类问题的通行办法是创建一个配置文件，或者数据库，用代码进行访问调用。 考虑到Excel本身就是一个强大的表格工具，所以对于Excel VBA应用，调用自身表格内容会是一个十分便捷的配置管理方法。 首先制作一个收件人管理表。 收件人管理表制作 首先确定一个原则:收件人信息都是用字符串的方式提供给程序的，有多个收件人时，必须用“;”(英文的分号)隔开。 当我们制作完一个收件人管理表格后，程序的收件人添加问题就变成了表格读取问题和字符串的拼接问题。 VBA中我们可以用function函数来实现功能的模块化，因为function函数是带返回值的 Private Function 收件人(Rng As Range) As String 收件人 = "" Dim Rr As Integer Rr = 2 While Rng.Cells(Rr, 1) <> "" 收件人 = 收件人 & Rng.Cells(Rr, 1) If Rng.Cells(Rr + 1, 1) <> "" Then 收件人 = 收件人 & ";" Rr = Rr + 1 Wend End Function 我们将收件人所在的那一列作为参数传入function，函数自动读取收件人，并组成收件人字符串返回给调用者。 基础代码相应部分可被修改为 .To = 收件人(Sheet1.[A:A]) '收件人 在A列 .CC = 收件人(Sheet1.[B:B]) '抄送 在B列 .BCC = 收件人(Sheet1.[C:C]) '密送 在C列 5：附件的管理 我们看基础代码 .Attachments.Add "D:RunLog.txt" '附件 在基础代码里，我是仅增加了一个附件，当需要添加多个附件时就需要调用多次.add 再实现附件添加模块化之前，我们需要研究如何进行附件的列表确认。对于多变的，需要经常维护的附件列表，手动在代码里进行.Attachments.Add显然是不现实的。 对于这个问题，我们可以用表格的形式，或文件夹遍历的形式进行。具体采用哪种方式取决于具体的需要。 这里我假设需要添加的附件已经写在了表格里。我们就可以用如下函数进行自动装载，整个函数类似收件人管理函数，但无需返回，在传参上略微复杂些 Private Sub 附件添加(附件 As Outlook.Attachments, Rng As Range) Dim Rr As Integer Rr = 2 While Rng.Cells(Rr, 1) <> "" 附件.Add Rng.Cells(Rr, 1).Text Rr = Rr + 1 Wend End Sub 这样基础代码中的附件添加可以改写为 附件添加 .Attachments, Sheet1.[D:D] 6：邮件正文图片添加 如果邮件的正文仅仅就是一句话，那么基础代码已经足够了。 但我们的mail，往往是图文并茂的，不仅有带格式的文字，还有漂亮表格，甚至夹插着图片。 Html可以提供这样的需求，正如常见的网页那样。 需要注意的是，Mail里的html和网页里的html是有所区别的，主要区别用“阉割版”这样的说法可能更容易理解。但它不影响表格，图片，文字的完美呈现，所以它也是足够受用的。 Mail正文里添加图片 .BodyFormat = olFormatHTML .HTMLBody = "<img src='F:图片汇总PHOTO.png'>" '正文 .Display 修改过的基础代码正文编辑部分。Html中我写入了一个img标签，并且加载了本地F盘里的一个图片。 这里需要特别注意的是：在用html设置好.HTMLBody后，我启用了一个.Display方法。该方法会让Outlook在屏幕上一闪而过，它是模拟的Outlook手动编辑的过程，可以将Html中引用的本地图片加载并修正到网络地址。否则对方收到Mail时，是无法正确显示图片的。 还有一个十分诡异的事情，如果img标签里设置了width和height参数，接收方往往是不能正确显示图片的，其中的原因不得而知。 如果想得到能控制尺寸的正文图片，需要用如下方法进行 .Attachments.Add "F:图片汇总PHOTO.png" .BodyFormat = olFormatHTML .HTMLBody = "<img src='cid:PHOTO.png' width='100' height='100'>" .Display 即，先将图片作为附件添加，然后img的src属性以cid：的方式进行引用。和直接引用图片地址相比，该方法必须提供width和height尺寸信息，否则也是不能正确显示的。 7：邮件正文表格添加 邮件正文添加表格，是通过HTML来实现的，当我们将自动邮件与Excel相结合时，通常希望能发送和Excel表格里一样的内容。如果我们将Excel里每一个关键属性都对应到Html属性里，通过编码的方式是可以实现的，单纯从技术的实现上，是不错的逻辑训练过程，但的确辛苦。 可喜的是，Excel里自带有表格区域向html的转换方法，它通过先将特定的区域保存为htm格式，然后再以文件读取的方式加载到.HTMLBODY中。 文件读取，我们首先需要到工具里引用“Microsoft Scripting Runtime”库，该库提供了一个强大的文件管理功能，可以用它轻松整体读取一个文件。 我们同样可以将这样的方法进行封装 Function Range_to_Html(Rng As Range) As String Dim PO As PublishObject Set PO = ThisWorkbook.PublishObjects.Add(xlSourceRange, "D:Result.htm", Rng.Parent.Name, Rng.Address, xlHtmlStatic) PO.Publish True PO.Delete Dim FS As FileSystemObject Set FS = New FileSystemObject Dim TS As TextStream Set TS = FS.OpenTextFile("D:Result.htm", ForReading, True, TristateUseDefault) Range_to_Html = TS.ReadAll End Function 该函数，要求一个期望加载到邮件正文的区域，其返回的就是代表那个表区域的HTML代码. .HTMLBody = Range_to_Html(Sheet2.[A1:O63]) 8 全功能代码 '工具->引用->Microsoft Outlook 16.0 Object Library '或者 Set Mail = CreateObject("Outlook.Application") Sub SendEmail() Dim mail As Outlook.Application Set mail = New Outlook.Application Dim objMail As Outlook.MailItem Set objMail = mail.CreateItem(olMailItem) With objMail .Subject = "My Test Mail" '主题 .To = 收件人(Sheet1.[A:A]) '收件人 .CC = 收件人(Sheet1.[B:B]) '抄送 .BCC = 收件人(Sheet1.[C:C]) '密送 附件添加 .Attachments, Sheet1.[D:D] '添加附件 .BodyFormat = olFormatHTML .HTMLBody = Range_to_Html(Sheet2.[A1:O63]) '正文 .Display .Send '执行发送 End With End Sub Private Sub 附件添加(附件 As Outlook.Attachments, Rng As Range) Dim Rr As Integer Rr = 2 While Rng.Cells(Rr, 1) <> "" 附件.Add Rng.Cells(Rr, 1).Text Rr = Rr + 1 Wend End Sub Private Function 收件人(Rng As Range) As String 收件人 = "" Dim Rr As Integer Rr = 2 While Rng.Cells(Rr, 1) <> "" 收件人 = 收件人 & Rng.Cells(Rr, 1) If Rng.Cells(Rr + 1, 1) <> "" Then 收件人 = 收件人 & ";" Rr = Rr + 1 Wend End Function '工具->引用-> Microsoft Scripting Runtime Function Range_to_Html(Rng As Range) As String Dim PO As PublishObject Set PO = ThisWorkbook.PublishObjects.Add(xlSourceRange, "D:Result.htm", Rng.Parent.Name, Rng.Address, xlHtmlStatic) PO.Publish True PO.Delete Dim FS As FileSystemObject Set FS = New FileSystemObject Dim TS As TextStream Set TS = FS.OpenTextFile("D:Result.htm", ForReading, True, TristateUseDefault) Range_to_Html = TS.ReadAll End Function |
|
|
