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

我的VBA代码循环访问列“我”与人名，并创build一个电子邮件列表。 在电子邮件正文中，列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