VBA按excel内容和模板批量发邮件

VBA按excel内容和模板通过outlook批量发邮件

前言：

建立包含vba的excel

1. 打开Excel工作簿，其中包含您的VBA代码。
2. 按下ALT + F11键打开Visual Basic for Applications（VBA）编辑器。
3. 在VBA编辑器中，找到您的Excel工作簿的项目资源管理器窗格。如果看不到该窗格，请按下CTRL + R键显示它。
4. 双击项目资源管理器窗格中的"Sheet1"（或包含收件人列表的工作表名称），以打开该工作表的代码窗口。
5. 在代码窗口中，将上述示例代码粘贴到空白区域中。
6. 确保在代码窗口中选择了正确的过程（Sub）名称，即"SendBulkEmails"。
7. 按下F5键或点击工具栏上的"运行"按钮来执行代码。
8. Outlook将自动打开并开始批量发送邮件。

Sub SendBulkEmails()
Dim outlookApp As Object
Dim myMail As Object
Dim sh As Worksheet
Dim cell, Filecell, rng As Range
Dim source_file, to_emails, cc_emails As String
Dim i, j As Integer
Dim xOutMsg As String

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set outlookApp = CreateObject("Outlook.application")
'Set myMail = outlookApp.CreateItem(0)
Set sh = Sheets("sheet1")


For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
    Set rng = sh.Cells(cell.Row, 1).Range("F1:M1")
    
    If cell.Value Like "?*@?*.?*" And _
    Application.WorksheetFunction.CountA(rng) > 0 Then
        Set myMail = outlookApp.CreateItemFromTemplate(sh.Cells(cell.Row, 5).Value)
        
        With myMail
            .Display '此处Display是为了添加default Outlook签名
            .To = sh.Cells(cell.Row, 1).Value
            .CC = sh.Cells(cell.Row, 2).Value
            .Subject = sh.Cells(cell.Row, 4).Value
            '修改邮件模板中的变量
            .HTMLBody = Replace(.HTMLBody, "[变量1]", "替换内容1")
            .HTMLBody = Replace(.HTMLBody, "[变量2]", "替换内容2")
            ' 可以根据需要修改更多变量
            'Signature = .HTMLBody & Signature '如果不添加签名可以用'注释掉这行
            
            '添加附件
            For Each Filecell In rng.SpecialCells(xlCellTypeConstants)
                
                If Trim(Filecell.Value) <> "" Then
                    If Dir(Filecell.Value) <> "" Then
                        .Attachments.Add Filecell.Value
                    End If
                End If
            Next Filecell
            '.send '正式发送可以将 ' 去掉
            .Display '预览效果
        End With
        
        Set myMail = Nothing
    End If
Next cell

Set outlookApp = Nothing

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Excel填写说明

1. A1:Receiver Address 接收人
2. B1:CC Address 抄送
3. C1:Subject 主题
4. D1:Tamplate 邮件模板
5. E1-M1:Attachment 附件地址（F列到N列可以填写附件地址，如果需要拓展要改这个代码-》Range(“F1:N1”)）

可能出现的问题

编译错误

如果您在VBA编辑器中看到了"Sub SendBulkEmails()行编译错误"的错误消息，可能是由于以下原因之一：

1. 缺少对Outlook对象库的引用：请确保您已经正确引用了Outlook对象库。在VBA编辑器中，点击菜单栏上的"工具"，然后选择"引用"。在弹出的对话框中，找到并选中"Microsoft Outlook xx.x Object Library"（其中xx.x表示Outlook版本号），然后点击"确定"按钮。

2. Outlook对象库版本不匹配：如果您的Outlook应用程序与您所引用的Outlook对象库的版本不匹配，也可能导致编译错误。请确保您的Outlook应用程序与您所引用的Outlook对象库版本相匹配。

• 以下是一些常见的Office版本和对应的Outlook库版本：

  Office 2019：Outlook 16.0库
  Office 2016：Outlook 16.0库
  Office 2013：Outlook 15.0库
  Office 2010：Outlook 14.0库

工具-引用为灰色

如果在VBA编辑器中，"工具"菜单下的"引用"选项是灰色的，那么可能有以下几种原因：

项目没有打开：请确保您已经打开了一个VBA项目。如果没有打开任何项目，"引用"选项将会被禁用。您可以通过打开一个Excel、Word或其他支持VBA的应用程序，并按下Alt+F11键来打开VBA编辑器。

VBA编辑器处于设计模式：如果VBA编辑器当前处于设计模式（例如，正在编辑用户窗体或类模块），则"引用"选项将被禁用。请尝试切换到标准模块（如模块1）以启用"引用"选项。

缺少管理员权限：如果您没有足够的管理员权限，可能无法更改VBA项目的引用设置。请确保您具有适当的权限。

如果上述解决方法都不起作用，请尝试重新安装Microsoft Office套件，并确保选择了完整安装选项。这样可以确保所有必需的文件和库正确安装并注册。

创建 Outlook 对象时未定义用户定义类型

参考文章中的代码这两行会报用户定义类型错误

Dim outlookApp As Outlook.Application
Dim myMail As Outlook.MailItem

所以我参考文章2将其定义改为了上面代码的形式。

参考：

1. Outlook 群发邮件并添加不同附件 -VBA
2. excel - 创建 Outlook 对象时未定义用户定义类型