基于Excel ID列表生成PDF后批量邮件发送的技术实现问询

基于你已有的PDF生成代码，我们可以扩展功能，实现生成PDF后直接发送至对应邮箱，或单独处理已生成的PDF批量发送。以下是具体方案：

前提准备 #

1. 在Excel工作表Statement中，确保邮箱列位于ID列（M列）右侧，从N4开始，每行对应ID的收件邮箱。
2. 确保已安装Microsoft Outlook，且开启程序访问权限（可在Outlook选项-信任中心-信任中心设置-程序访问中配置）。

整合PDF生成与邮件发送的完整代码 #

该代码会在生成每个PDF后立即发送至对应邮箱：

Sub SavePDFsAndSendEmails()
    
    '声明变量
    Dim ws As Worksheet
    Dim rngID As Range
    Dim rngListStart As Range
    Dim rowsCount As Long
    Dim i As Long
    Dim pdfFilePath As String
    Dim tempPDFFilePath As String
    Dim olApp As Object
    Dim olMail As Object
    Dim recipientEmail As String
    
    '关闭屏幕刷新提升运行速度
    Application.ScreenUpdating = False
    
    '引用生成PDF的工作表
    Set ws = ActiveWorkbook.Sheets("Statement")
    
    '设置触发PDF内容变化的单元格（A1）
    Set rngID = ws.Range("A1")
    
    '设置ID列表起始单元格（M4）
    Set rngListStart = ws.Range("M4")
    
    '获取ID列表的行数
    rowsCount = rngListStart.CurrentRegion.Rows.Count - 1
    
    'PDF保存路径模板
    pdfFilePath = "C:\Test Folder\PDF Export\Example - [ID].pdf"
    
    '初始化Outlook对象（后期绑定，无需手动添加引用）
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    For i = 1 To rowsCount
        '更新当前ID
        rngID.Value = rngListStart.Offset(i - 1, 0).Value
        
        '获取对应邮箱地址（N列，偏移1列）
        recipientEmail = rngListStart.Offset(i - 1, 1).Value
        
        '生成PDF路径
        tempPDFFilePath = Replace(pdfFilePath, "[ID]", rngID.Value)
        
        '生成PDF
        ws.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=tempPDFFilePath
        
        '发送邮件（若邮箱不为空）
        If recipientEmail <> "" Then
            Set olMail = olApp.CreateItem(0) '0代表邮件项
            With olMail
                .To = recipientEmail
                .Subject = "你的账单 - ID: " & rngID.Value
                .Body = "您好，附件是您的账单PDF文件，请查收。"
                .Attachments.Add tempPDFFilePath '添加PDF附件
                .Send '直接发送，如需预览可改为.Display
            End With
            Set olMail = Nothing
        End If
    Next i
    
    '释放Outlook对象
    Set olApp = Nothing
    
    '恢复屏幕刷新
    Application.ScreenUpdating = True
    
    MsgBox "所有PDF已生成并发送完成！", vbInformation
End Sub

单独发送已生成PDF的代码 #

若已提前生成所有PDF，仅需批量发送，可使用以下代码：

Sub SendExistingPDFs()
    Dim ws As Worksheet
    Dim rngListStart As Range
    Dim rowsCount As Long
    Dim i As Long
    Dim pdfFilePath As String
    Dim tempPDFFilePath As String
    Dim olApp As Object
    Dim olMail As Object
    Dim recipientEmail As String
    Dim idValue As String
    
    Application.ScreenUpdating = False
    
    Set ws = ActiveWorkbook.Sheets("Statement")
    Set rngListStart = ws.Range("M4")
    rowsCount = rngListStart.CurrentRegion.Rows.Count - 1
    pdfFilePath = "C:\Test Folder\PDF Export\Example - [ID].pdf"
    
    '初始化Outlook对象
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    For i = 1 To rowsCount
        idValue = rngListStart.Offset(i - 1, 0).Value
        recipientEmail = rngListStart.Offset(i - 1, 1).Value
        tempPDFFilePath = Replace(pdfFilePath, "[ID]", idValue)
        
        '仅当邮箱存在且PDF文件存在时发送
        If recipientEmail <> "" And Dir(tempPDFFilePath) <> "" Then
            Set olMail = olApp.CreateItem(0)
            With olMail
                .To = recipientEmail
                .Subject = "你的账单 - ID: " & idValue
                .Body = "您好，附件是您的账单PDF文件，请查收。"
                .Attachments.Add tempPDFFilePath
                .Send
            End With
            Set olMail = Nothing
        End If
    Next i
    
    Set olApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "所有邮件发送完成！", vbInformation
End Sub

关键说明 #

• 邮箱列调整：若邮箱列不在N列，修改Offset(i - 1, 1)中的数字1为对应偏移量（如O列则改为2）。
• 邮件内容定制：可修改.Subject和.Body的文本，调整邮件主题和正文。
• 预览模式：将.Send改为.Display可在发送前预览邮件。

内容的提问来源于stack exchange，提问作者J Church