Question

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

我有2张1和2张。

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

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

0down voteaccept

它在Sheet 2专栏B

中

我在第1栏B栏中有客户名称，并且在第2栏A列和B栏中的电子邮件地址中有相应的名称

我创建了一个下面的代码，但不确定如何在VBA中创建一个字符串??

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

VBA，Outlook，多封电子邮件

1 个答案: