通过使用Excel VBA来进行Outlook自动邮件发送

1、创建Excel

我们需要创建一个xlsm后缀的excel文件,该后缀文件支持宏的使用

2、Excel操作

添加一些列

|-----|-----|-------------|------|------|------|------|
| 收件人 | 抄送人 | Outlook模板路径 | 替换内容 | 附件内容 | 插入图片 | 是否发送 |

列的解释

收件人:你要发送给谁,以;进行连接

抄送人:抄送对象,以;进行连接

Outlook模板路径:Outlook所设置的模板,注意模板保存后缀为oft,例子:C:\Users\xx\Desktop\test.oft,路径不需要双引号。

替换内容:对模板中的内容进行替换,以:(替换词1>替换内容1;替换词2>替换内容2)的形式。例子:《天气状况》>差;《活动》>打麻将;《交通工具》>地铁。不需要书名号也可以进行替换。

附件内容:添加附件的路径,以;进行连接

插入图片:插入图片到指定位置,其中例子:Image1>C:\Users\z004zwey\Desktop\img\By Territory.png;Image2>C:\Users\z004zwey\Desktop\img\OR chart.png,同替换内容类似,要替换的字符串>图片路径。

是否发送:(1直接发送0设置为草稿,2仅显示)

设置使用宏

进入excel设置,对开发者窗口打勾

设置宏信任

3、VBA代码编写

引用outlook

发送代码

vbnet 复制代码
Sub SendEmail()
Dim smallMessenger As Outlook.Application
Set smallMessenger = New Outlook.Application

Dim newEmail As MailItem
Dim row, rows As Integer

Dim recipient As String
Dim ccRecipients As String
Dim subject As String
Dim outlookTemplatePath As String
Dim replacementContent As String
Dim attachmentContent As String
Dim insertImages As String
Dim sendDirectly As String
Dim strImageHTML As String


Dim i, j As Integer

Dim Before() As Variant
Dim Back() As Variant
Dim attachs() As String


rows = ActiveSheet.UsedRange.rows.Count

For i = 2 To rows
    recipient = Cells(i, "A")
    ccRecipients = Cells(i, "B")
    subject = Cells(i, "C")
    outlookTemplatePath = Cells(i, "D")
    replacementContent = Cells(i, "E")
    attachmentContent = Cells(i, "F")
    insertImages = Cells(i, "G")
    sendDirectly = Cells(i, "H")
    Set newEmail = smallMessenger.CreateItemFromTemplate(outlookTemplatePath)
    newEmail.To = recipient
    newEmail.CC = ccRecipients
    newEmail.subject = subject
    ' 鏇挎崲鍐呭
    If replacementContent = "" Then
        GoTo label1
    End If
    Before = getBefore(replacementContent)
    Back = getBack(replacementContent)
    For j = LBound(Before) To UBound(Before)
        newEmail.HTMLBody = Replace(newEmail.HTMLBody, Before(j), Back(j))
    Next
label1:
    ' 闄勪欢鍐呭
    If attachmentContent = "" Then
        GoTo label2
    End If
    attachs = Split(attachmentContent, ";")
    For j = LBound(attachs) To UBound(attachs)
        newEmail.Attachments.Add (attachs(j))
    Next
label2:
    '鎻掑叆鍥剧墖
    If insertImages = "" Then
        GoTo label3
    End If
    Before = getBefore(insertImages)
    Back = getBack(insertImages)
    For j = LBound(Before) To UBound(Before)
        strImageHTML = "<img src='" & Back(j) & "'>"
        newEmail.HTMLBody = Replace(newEmail.HTMLBody, Before(j), strImageHTML)
    Next
label3:
    If sendDirectly = 1 Then
        newEmail.Send
    ElseIf sendDirectly = 2 Then
        newEmail.Display
    ElseIf sendDirectly = 0 Then
        newEmail.Close olSave
    End If
Next




End Sub
Function getBefore(ByVal inputText As String) As Variant()
    Dim tokens() As String
    Dim result() As Variant
    Dim curtokens() As String
    
    Dim i As Integer
    tokens = Split(inputText, ";")
    ReDim result(0 To UBound(tokens))
    For i = LBound(tokens) To UBound(tokens)
        curtokens = Split(tokens(i), ">")
        result(i) = curtokens(0)
    Next
    getBefore = result
End Function

Function getBack(ByVal inputText As String) As Variant()
    Dim tokens() As String
    Dim result() As Variant
    Dim curtokens() As String
    
    Dim i As Integer
    tokens = Split(inputText, ";")
    ReDim result(0 To UBound(tokens))
    For i = LBound(tokens) To UBound(tokens)
        curtokens = Split(tokens(i), ">")
        result(i) = curtokens(1)
    Next
    getBack = result
End Function

创建一个按钮绑定宏

一些问题:

excel不保存宏:每次写完宏代码后,退出重新打开不进行保存,解决办法:将excel设置为英文形式。

相关推荐
njsgcs10 小时前
excel-mcp-server 安装
excel·mcp
未来之窗软件服务1 天前
万象EXCEL开发(九)excel 高级混合查询 ——东方仙盟金丹期
大数据·excel·仙盟创梦ide·东方仙盟·万象excel
深耕AI应用1 天前
元表纪基于一个Excel表实现一键发货、打印面单
excel·表格一键发货·自动打印运单·自动打印面单·自动发货
专注VB编程开发20年1 天前
EXCEL VBA-从X行复制数据插入到Y_Z行
excel·复制数据·vba·插入数据·函数优化
小Tomkk1 天前
一个学校随机点名系统(代excel 自定义导入名字,+随机点名)
excel
未来之窗软件服务1 天前
万象EXCEL开发(十二)excel 结构化查询 ——东方仙盟金丹期
excel·仙盟创梦ide·东方仙盟·万象excel
专注VB编程开发20年3 天前
VB6.0找不到该引用word,excel“Microsoft Excel 16.0 Object Library”解决方法
word·excel·vba·vsto
林月明4 天前
【VBA】点击按钮,实现将Excel表A数据按格式填入表B
excel·vba
Bella_chene5 天前
Excel转PDF不分页
pdf·excel
goto_w5 天前
前端实现复杂的Excel导出
前端·excel