从Excel文件向多个收件人发送Outlook电子邮件 [英] Sending Outlook Email with multiple recipients from Excel file

问题描述

我目前正在做一个VBA宏，它将发送具有以下条件的SINGLE Outlook电子邮件:

I am currently doing a VBA-macro that would send a SINGLE outlook email having the following criteria:

A.收件人列在工作表Sheet1的D列中，我想要的只是将每个发件人连接到Outlook的收件人"字段中.但是，这些接收者是动态的，在数量上可能有所不同.案例可能会导致在这些列中添加或删除电子邮件地址.

A. The recipients are listed in column D of Sheet1 and all I want is to concatenate each sender in TO field of outlook. However, these recipients are dynamic and could be different in terms of number. Cases may lead to adding or subtracting email addresses from these column.

B.我需要将Sheet2的任何内容粘贴到Outlook的BODY字段中. C.我需要生成带有签名的电子邮件.

B. I need to paste whatever the content of Sheet2 in the BODY field of outlook. C. I need to generate an email with signature.

到目前为止，我已经有了这段代码，但是它却无法正常工作:

So far, I have this code but it's not working though:

Option Explicit

Sub SendEmail()

Dim OutlookApplication As Outlook.Application
Dim OutlookMailItem As Outlook.MailItem
Dim outlookInspector As Outlook.Inspector
Dim wdDoc As Word.Document
Dim Recipient As Range
Dim CC As Range

Application.ScreenUpdating = False

Set OutlookApplication = New Outlook.Application
Set OutlookMailItem = OutlookApplication.CreateItem(0)

'On Error GoTo cleanup

    Workbooks("ConfigFile.xlsm").Sheets("Sheet1").Activate

    Range("D2").Select
    Set Recipient = Range(ActiveCell, ActiveCell.End(xlDown))

    Range("E2").Select
    Set CC = Range(ActiveCell, ActiveCell.End(xlDown))

    With OutlookMailItem
        .Display
        .To = Recipient
        .CC = CC
        .subject = ThisWorkbook.Sheets("Sheet1").Range("F2").Value
        .Body = ThisWorkbook.Sheets("Sheet1").Range("G2").Value

        Set outlookInspector = .GetInspector
        Set wdDoc = outlookInspector.WordEditor

        wdDoc.Range.InsertBreak

        Sheet2.Activate
        Range("A:A").CurrentRegion.Copy

        wdDoc.Range.Paste

    End With


'cleanup:
    'Set OutlookApplication = Nothing
    'Application.ScreenUpdating = True

End Sub

推荐答案

要回答问题的第一部分，请替换.To& .CC带有:

To answer the first part of your question, replace the .To & .CC with:

Dim myDelegate As Outlook.Recipient

    For Each sTo In Recipient
        Set myDelegate = OutlookMailItem.Recipients.Add(sTo)
        myDelegate.Resolve
        If Not myDelegate.Resolved Then
            myDelegate.Delete
        End If
    Next sTo

    For Each sTo In CC
        Set myDelegate = OutlookMailItem.Recipients.Add(sTo)
        myDelegate.Type = olCC
        myDelegate.Resolve
        If Not myDelegate.Resolved Then
            myDelegate.Delete
        End If
    Next sTo

这会遍历D列和D列中的每个人. E并将其输入到相关字段中，如果某人不存在，它将删除该人，如果您不希望这种情况发生，只需在上述每个循环中删除If语句

This loops through each of the people you have in column D & E and will input them into the relevant fields, in the case of someone not existing it will remove that person, if you don't want this to happen simply remove the If statement in each of the loops above

您的其他2个问题应单独询问，但是Google进行的快速搜索发现了类似的问题，可能会对您有所帮助

Your other 2 questions should be asked separately but a quick Google search found similar issue which may help you

用于将数据从Excel粘贴到Outlook正文

用于电子邮件签名

我用于 .To & .CC 要回答您的问题，您可能需要看看它们，它们可能会在将来为您提供帮助

What I used for the .To & .CC To answer your question, you may want to look at them, they may help you in the future

这篇关于从Excel文件向多个收件人发送Outlook电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！