Question

我试图创建一个循环，将Excel中的电子邮件发送到一个电子邮件列表，其中一个电子邮件地址和另一个电子邮件地址之间有空单元格。

问题在于，每当我到.send行时，子结束并且不再继续循环到下一个E邮件地址。

我希望我能说清楚，而且我不是在胡说八道。这是我试图运行的代码（Excel表格也是他的atrts）

Private Sub CommandButton1_Click()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
Dim Login_EmailAddress, Login_EmailPassword, SMTPServer As String
Dim ServerPort As Integer
Dim To_Email, CC_Email, BCC_Email, Email_Subject, Email_Body, Attachment_Path     As String
Dim CustomerEmail As String
Dim finalrow As Integer
Dim i As Integer
Dim x As Integer

x = ThisWorkbook.Sheets("birthdaymail").Cells(Rows.Count, 7).End(xlUp).Row
i = x - 1
'Do
'Loop Until CustomerEmail = Range("G1")
line1:

    CustomerEmail = Sheets("birthdaymail").Cells(i, 7).Value
    i = i - 1



'********************ACCOUNT DETAILS********************************************************************************
SMTPServer = "smtp.gmail.com"
ServerPort = 465
Login_EmailAddress = "*****@gmail.com"
Login_EmailPassword = "#######"

'*********************EMAIL DETAILS******************************************
To_Email = CustomerEmail
CC_Email = ""                   '"deepak.lohia@gmail.com"
BCC_Email = ""                  '"deepak.lohia@gmail.com"
Attachment_Path = ""            '"C:\Users\dpk-pc\Desktop\shortcut\photo.jpg"
Email_Subject = "áãé÷ä àçú ùúééí ùìåù àøáò"
Email_Body = "æä îééì áãé÷ä 2/2/2018"
'****************************************************************************************************

With myMail.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ServerPort
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Login_EmailAddress
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Login_EmailPassword
    .Update
End With

With myMail
    .From = Login_EmailAddress
    .Subject = Email_Subject
    .To = To_Email
    .CC = CC_Email
    .BCC = BCC_Email
    .TextBody = Email_Subject
    If Attachment_Path <> "" Then .AddAttachment Attachment_Path
    If To_Email = ThisWorkbook.Sheets("birthdaymail").Cells(1, 7) Then GoTo line2
    If To_Email = "" Then GoTo line1
    .Send
    End With



If To_Email = "" Then GoTo line1
On Error Resume Next

line2:
If Err.Number <> 0 Then
  MsgBox Err.Description, vbCritical
Else
line2:
  MsgBox ("Mail has been sent"), vbInformation
End If

End Sub

Excel表格PrtScr：

Answer 1

如果使用带有If语句的For循环来循环G列，如果单元格不为空，请使用该电子邮件地址并继续，我还将您的声明从Integer更改为Long并修改了一对String声明，因为它们不正确。

我注意到在您的图片中您正在使用过滤器，如果您想要将电子邮件仅发送到已过滤的列表，则下面的代码也会循环显示可能不可见的单元格，然后代码需要稍加修改。

Private Sub CommandButton1_Click()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
Dim Login_EmailAddress, Login_EmailPassword As String, SMTPServer As String
Dim ServerPort As Integer
Dim To_Email, CC_Email As String, BCC_Email As String, Email_Subject As String, Email_Body As String, Attachment_Path     As String
Dim CustomerEmail As String
Dim finalrow As Integer
Dim i As Long
Dim x As Long

x = ThisWorkbook.Sheets("birthdaymail").Cells(Rows.Count, 7).End(xlUp).Row

line1:
For i = 2 To x
    If Sheets("birthdaymail").Cells(i, 7).Value <> "" Then
       CustomerEmail = Sheets("birthdaymail").Cells(i, 7).Value

       '********************ACCOUNT DETAILS********************************************************************************
       SMTPServer = "smtp.gmail.com"
       ServerPort = 465
       Login_EmailAddress = "*****@gmail.com"
       Login_EmailPassword = "#######"

       '*********************EMAIL DETAILS******************************************
       To_Email = CustomerEmail
       CC_Email = ""                   '"deepak.lohia@gmail.com"
       BCC_Email = ""                  '"deepak.lohia@gmail.com"
       Attachment_Path = ""            '"C:\Users\dpk-pc\Desktop\shortcut\photo.jpg"
       Email_Subject = "áãé÷ä àçú ùúééí ùìåù àøáò"
       Email_Body = "æä îééì áãé÷ä 2/2/2018"
       '****************************************************************************************************

       With myMail.Configuration.Fields
           .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
           .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
           .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
           .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ServerPort
           .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
           .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Login_EmailAddress
           .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Login_EmailPassword
           .Update
       End With

       With myMail
           .From = Login_EmailAddress
           .Subject = Email_Subject
           .To = To_Email
           .CC = CC_Email
           .BCC = BCC_Email
           .TextBody = Email_Subject
           If Attachment_Path <> "" Then .AddAttachment Attachment_Path
           .Send
       End With
    End If
Next i
End Sub

创建一个将发送电子邮件的循环

1 个答案: