Question

我的VBA代码循环通过Column＆＃34; I＆＃34;使用人的姓名并创建电子邮件列表。在电子邮件正文中，列B，C，G，I中的每个人的行列表非常简单，但我遇到了后者的问题。它只占用每个人的第一行，即不会遍历列表以获取一个收件人的所有行。我有种感觉这会阻止它进一步循环：

         If InStr(1, PriorRecipients, EmailAddr) <> 0 Then
             GoTo NextRecipient
         End If

但不确定如何实现第二个循环??

完整代码：

  Sub SendEmail2()

    Dim OutlookApp
    Dim MItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    Dim Msg As String
    Dim Projects As String
    Dim ProjectsMsg As String
    Dim bSendMail As Boolean


    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set MItem = OutlookApp.CreateItem(0)
    'Loop through the rows
    For Each cell In Columns("I").Cells.SpecialCells(xlCellTypeVisible)
     If cell.Value <> "" And _
           (Cells(cell.Row, "L").Value) = "No" And (Cells(cell.Row, "K").Value) <> "Yes" Then
            'first build email address
            EmailAddr = LCase$(Replace(cell.Value, " ", ".")) & "@company.com"
            'then check if it is in Recipient List build, if not, add it, otherwise ignore
            If InStr(1, Recipient, EmailAddr) = 0 Then Recipient = Recipient & ";" & EmailAddr

             Projects = vbCrLf & "Document: " & Cells(cell.Row, "B").Value & "; " & Cells(cell.Row, "C").Value & "; " & "Rev " & Cells(cell.Row, "G").Value & "; " & Cells(cell.Row, "I").Value
             If InStr(1, ProjectsMsg, Projects) = 0 Then ProjectsMsg = ProjectsMsg & Projects & vbCrLf

        If InStr(1, Recipient, cell.Offset(1).Value) <> 0 Then
          bSendMail = True
          Recipient = Recipient & ";" & cell.Offset(1)
            Else
           bSendMail = False
        End If

End If
Next
    Msg = "You have the following outstanding documents to be reviewed at: "& ProjectsMsg
    Subj = "Outstanding Documents to be Reviewed"
    'Create Mail Item and view before sending
  If bSendMail Then Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = Recipient 'full recipient list
        .Subject = Subj
        .Body = Msg
        .display

    End With


End Sub

Answer 1

更改此代码块：

  If InStr(1, PriorRecipients, EmailAddr) <> 0 Then
     GoTo NextRecipient
  End If

  PriorRecipients = PriorRecipients & ";" & EmailAddr

到此

If InStr(1, PriorRecipients, EmailAddr) = 0 Then
    PriorRecipients = PriorRecipients & ";" & EmailAddr
End If

'checks if it's the last email for that unique person and if so,
`it's done looping rows for that email and the email is good to send
If Instr(1, PriorRecipients, cell.Offset(1).Value) <> 0 Then 
    Dim bSendMail as Boolean
    bSendMail = True
    PriorRecipients = PriorRecipients & ";" & cell.Offset(1)
Else
    bSendMail = False
End If

If bSendMail Then 
   Set MItem = OutlookApp.CreateItem(olMailItem)
   ' rest of code to send mail ... 
End If

在Excel VBA中循环遍历多个列的问题

1 个答案: