Как перебрать все строки столбца для отправки нескольких писем с помощью strTo?

Question

Как я могу отправить несколько электронных писем на адреса электронной почты из столбца в VBA?

Я попытался поместить цикл в качестве переменной в значения ячейки. Попытка установить диапазон для строки, но отправляется только первое электронное письмо в строке 1, а не остальные строки. Я новичок в vba, как я могу пройтись по диапазону и отправить на эти адреса электронной почты в диапазоне?

Sub send_email()

Dim NewMail As Object
Dim MailConfig As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strsub As String
Dim strBody As String
Dim fields As Variant
Dim msConfigURL As String
Dim FormulaCell As Range
Set FormulaCell = Range("A1:A10")
Dim i As Long
For i = 1 To 50
If i = 50 Then Exit For
Next i

strSubject = "Mail from Excel"
strFrom = "123@gmail.com"
strTo = Cells(FormulaCell.Row, "A").Value
strCc = ""
strBcc = ""
strsub = "123"

    strBody = "Dear " & Cells(FormulaCell.Row, "A").Value & vbNewLine & vbNewLine & _
              vbNewLine & vbNewLine & "we are ing this call to you : " & Cells(FormulaCell.Row, "B").Value & _
              vbNewLine & vbNewLine & "Your total of this week is : " & Cells(FormulaCell.Row, "B").Value & _
              vbNewLine & _
              vbNewLine & _
              vbNewLine & vbNewLine & "Thanks and Regards" & vbNewLine & _
              vbNewLine & "Uedamoorthy CCSC" & vbNewLine & _
              vbNewLine & "CCSC Che"
            Str (Sheet1.Cells(1, 1)) & Str(Sheet1.Cells(1, 2))


Set NewMail = CreateObject("CDO.Message")
Set MailConfig = CreateObject("CDO.Configuration")

MailConfig.Load -1

Set fields = MailConfig.fields

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        'Enable SSL Authentication
        .Item(msConfigURL & "/smtpusessl") = True

        'Make SMTP authentication Enabled=true (1)
        .Item(msConfigURL & "/smtpauthenticate") = 1

        'Set the SMTP server and port Details
        'To get these details you can get on Settings Page of your Gmail Account
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2

        'Set your credentials of your Gmail Account
        .Item(msConfigURL & "/sendusername") = ""
        .Item(msConfigURL & "/sendpassword") = ""

        'Update the configuration fields
        .Update

    End With
    NewMail.Configuration = MailConfig
    NewMail.Subject = strSubject
    NewMail.From = strFrom
    NewMail.To = strTo
    NewMail.TextBody = strBody
    NewMail.CC = strCc
    NewMail.BCC = strBcc
    NewMail.Send
    MsgBox ("Value has been Sent")

Exit_Err:

    Set NewMail = Nothing
    Set MailConfig = Nothing
    End



End Sub

Спасибо за любые указатели.

Answer 1

слишком много копий / вставок) заполните данные и отправьте почту должно быть IN цикл: Sub send_email ()

Dim NewMail As Object
Dim MailConfig As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strsub As String
Dim strBody As String
Dim fields As Variant
Dim msConfigURL As String
Dim i As Long
    strSubject = "Mail from Excel"
    strFrom = "123@gmail.com"
    For i = 1 To 50
        strTo = Cells(i, 1).Value
        strCc = ""
        strBcc = ""
        strsub = "123"

        strBody = "Dear " & Cells(i, 1).Value & vbNewLine & vbNewLine & _
                  vbNewLine & vbNewLine & "we are ing this call to you : " & Cells(i, 1).Value & _
                  vbNewLine & vbNewLine & "Your total of this week is : " & Cells(i, 1).Value & _
                  vbNewLine & _
                  vbNewLine & _
                  vbNewLine & vbNewLine & "Thanks and Regards" & vbNewLine & _
                  vbNewLine & "Uedamoorthy CCSC" & vbNewLine & _
                  vbNewLine & "CCSC Che"
'Str (Sheet1.Cells(1, 1)) & Str(Sheet1.Cells(1, 2)) ---------------- wthat's this?
        Set NewMail = CreateObject("CDO.Message")
        Set MailConfig = CreateObject("CDO.Configuration")

        MailConfig.Load -1

        Set fields = MailConfig.fields

        msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

        With fields
            'Enable SSL Authentication
            .Item(msConfigURL & "/smtpusessl") = True

            'Make SMTP authentication Enabled=true (1)
            .Item(msConfigURL & "/smtpauthenticate") = 1

            'Set the SMTP server and port Details
            'To get these details you can get on Settings Page of your Gmail Account
            .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
            .Item(msConfigURL & "/smtpserverport") = 465
            .Item(msConfigURL & "/sendusing") = 2

            'Set your credentials of your Gmail Account
            .Item(msConfigURL & "/sendusername") = ""
            .Item(msConfigURL & "/sendpassword") = ""

            'Update the configuration fields
            .Update

        End With
        NewMail.Configuration = MailConfig
        NewMail.Subject = strSubject
        NewMail.From = strFrom
        NewMail.To = strTo
        NewMail.TextBody = strBody
        NewMail.CC = strCc
        NewMail.BCC = strBcc
        NewMail.Send
        MsgBox ("Value has been Sent")

Exit_Err:
        Set NewMail = Nothing
        Set MailConfig = Nothing
        End
    Next
'------------------finish loop
End Sub

, но следующий немного лучше, чем для меня (то же самоекод, просто сгруппировать его):

Sub send_email()

Dim NewMail As Object
Dim MailConfig As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strsub As String
Dim strBody As String
Dim fields As Variant
Dim msConfigURL As String
Dim i As Long
    strSubject = "Mail from Excel"
    strFrom = "123@gmail.com"
    strCc = ""
    strBcc = ""
    strsub = "123"

'Str (Sheet1.Cells(1, 1)) & Str(Sheet1.Cells(1, 2)) ---------------- wthat's this?
    Set NewMail = CreateObject("CDO.Message")
    Set MailConfig = CreateObject("CDO.Configuration")

    MailConfig.Load -1

    Set fields = MailConfig.fields

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        'Enable SSL Authentication
        .Item(msConfigURL & "/smtpusessl") = True

        'Make SMTP authentication Enabled=true (1)
        .Item(msConfigURL & "/smtpauthenticate") = 1

        'Set the SMTP server and port Details
        'To get these details you can get on Settings Page of your Gmail Account
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2

        'Set your credentials of your Gmail Account
        .Item(msConfigURL & "/sendusername") = ""
        .Item(msConfigURL & "/sendpassword") = ""

        'Update the configuration fields
        .Update

    End With
    NewMail.Configuration = MailConfig
    NewMail.Subject = strSubject
    NewMail.From = strFrom
    NewMail.CC = strCc
    NewMail.BCC = strBcc
'--------------- start loop
    For i = 1 To 50
        strTo = Cells(i, 1).Value
        strBody = "Dear " & Cells(i, 1).Value & vbNewLine & vbNewLine & _
                 vbNewLine & vbNewLine & "we are ing this call to you : " & Cells(i, 1).Value & _
                 vbNewLine & vbNewLine & "Your total of this week is : " & Cells(i, 1).Value & _
                 vbNewLine & _
                 vbNewLine & _
                 vbNewLine & vbNewLine & "Thanks and Regards" & vbNewLine & _
                 vbNewLine & "Uedamoorthy CCSC" & vbNewLine & _
                 vbNewLine & "CCSC Che"
        NewMail.To = strTo
        NewMail.TextBody = strBody
        NewMail.Send
        MsgBox ("Value has been Sent")

Exit_Err:
        Set NewMail = Nothing
        Set MailConfig = Nothing
        End
    Next
'------------------finish loop
End Sub