如何创建一个 to 字符串？

Question

我正在尝试为多个收件人创建 Outlook 电子邮件。

我有两张纸 1 和 2。

我希望工作表 1 列 B 中的代码查看工作表 2 列 A 并选择与代码匹配的所有电子邮件地址，并在 tostring 中创建包含收件人列表的电子邮件，并对第二个代码执行重复任务直到其为空。

还要在表 1 的 c 列中附上与该代码对应的文件。

它在工作表 2 列 B 中

我在表格 1 B 列中有客户姓名，在表格 2 A 列中有相应的姓名，在 B 列中有电子邮件地址。

我创建了下面的代码。如何在 VBA 中创建一个 to 字符串？

Sub GenerateEmail()
i = 2 ' selects row 2 ,since row 1 ,i am keeping for titles
Dim wbBook As Excel.Workbook
Dim doText As DataObject
Dim wsSheet As Excel.Worksheet
Dim x As Variant
Dim myemail As String
Dim myrange As Range
Dim n As Range
Dim sm2 As Range

Set wbBook = ThisWorkbook
Set sm2 = ThisWorkbook.Sheets("Sheet 2").Range("A2:A1000")
Set sm1 = ThisWorkbook.Sheets("Sheet 1").Range("B2:B1000")

Do Until ThisWorkbook.Sheets("Sheet 1").Cells(i, "B").Value = ""

    EmailTo = tostring

    BCC = ThisWorkbook.Sheets("Sheet 1").Range("J3").Value
    Subj = ThisWorkbook.Sheets("Sheet 1").Range("J4").Value
    Path = "N:\Folder 1\Folder 2\Folder 3\Folder 3\Result\"
    FileName = ThisWorkbook.Sheets("Sheet 1").Cells(i, 3)
    SM = ThisWorkbook.Sheets("Sheet 1").Cells(i, 2)

    x = Replace(Range("Content1").Value, "<PROJECTION DATE1>", Format(Range("GenerationMonth").Value, "mmmm"))
    x = x & Replace(Range("Content2").Value, "<PROJECTION DATE2>", Format(Range("GenerationMonth").Value, "mmmm-yyyy"))
    x = x & ThisWorkbook.Sheets("Sheet 3").Range("Content3").Value
    Msg = x

    Application.ScreenUpdating = False
    Application.StatusBar = "Preparing email..."
    Application.DisplayAlerts = False

    'Variables for MS Outlook.
    'Variables for MS Outlook.

    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .SentOnBehalfOfName = "Cleint1@Hotmail.com"
        .To = EmailTo
        .BCC = "Cleint1@Hotmail.com"
        .Subject = "This is my subject" & Format(DateAdd("m", -1, Date), "mmmm yyyy")
         .Attachments.Add Path & FileName
        .Display
        .BodyFormat = olFormatPlain
        .Body = Msg
        'send
    End With
    i = i + 1
    Set doText = Nothing
    Application.CutCopyMode = False

Loop

Cells(7, "J").Value = "Outlook msg count =" & i - 1

Set OutMail = Nothing
Set OutApp = Nothing

Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Workbooks(MyFile).Close

End Sub

Answer 1

这是启动循环并获取“To:”变量的一种方法。

我注释掉了大部分代码，因为我没有你的工作簿，而且代码在我的情况下不起作用。

Sub DoItEmail()


'Dim doText As DataObject
    Dim x As Variant
    Dim myemail As String
    Dim myrange As Range
    Dim n As Range
    Dim sm2 As Range

    Dim OutApp As Object
    Dim OutMail As Object
    '==================================================================
    Dim sh As Worksheet, ws As Worksheet, wb As Workbook
    Dim Rws As Long, Rng As Range, c As Range
    Dim Rws2 As Long, Rng2 As Range, b As Range, SndTo As String

    Set sh = Sheets("Sheet1")
    Set ws = Sheets("Sheet2")
    Application.ScreenUpdating = 0

    With sh
        Rws = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range("A2:A" & Rws)
    End With
    With ws
        Rws2 = .Cells(.Rows.Count, "C").End(xlUp).Row
        Set Rng2 = .Range("C2:C" & Rws2)
    End With

    For Each c In Rng.Cells
        For Each b In Rng2.Cells
            If b = c Then
                SndTo = b.Offset(0, 1)    'this would be your "to:" variable
                'MsgBox SndTo & " is the To: variable"

                'EmailTo = tostring

                BCC = sh.Range("J3").Value
                Subj = sh.Range("J4").Value
                'Path = "N:\Folder 1\Folder 2\Folder 3\Folder 3\Result\"
                'FileName = sh.Cells(i, 3)
                'SM = sh.Cells(i, 2)


                '            x = Replace(Range("Content1").Value, "<PROJECTION DATE1>", Format(Range("GenerationMonth").Value, "mmmm"))
                '            x = x & Replace(Range("Content2").Value, "<PROJECTION DATE2>", Format(Range("GenerationMonth").Value, "mmmm-yyyy"))
                '            x = x & ThisWorkbook.Sheets("Sheet 3").Range("Content3").Value
                '            Msg = x



                Application.ScreenUpdating = False
                'Application.StatusBar = "Preparing email..."
                Application.DisplayAlerts = False


                'Variables for MS Outlook.
                'Variables for MS Outlook.



                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .SentOnBehalfOfName = "Cleint1@Hotmail.com"
                    .To = SndTo
                    .BCC = "Cleint1@Hotmail.com"
                    .Subject = "This is my subject: " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
                    '.Attachments.Add Path & FileName
                    .Display
                    .BodyFormat = olFormatPlain
                    .Body = Msg
                    'send
                End With
                i = i + 1
                Set doText = Nothing
                Application.CutCopyMode = False



                Cells(7, "J").Value = "Outlook msg count =" & i

                Set OutMail = Nothing
                Set OutApp = Nothing

                Application.DisplayAlerts = False
                Application.ScreenUpdating = False
                'Workbooks(MyFile).Close
            End If

        Next b
    Next c
    Application.StatusBar = False

End Sub