直到在Excel中循环

您好我正在尝试循环,直到它find最后一个单元格,然后停止,但是当它到达空单元格时,它给我一个错误,因为没有人通过电子邮件发送到最后一个空单元格。 我会复制我的代码,所以你可能明白我的意思。

Sub SendMassEmail() row_number = 0 Do DoEvents row_number = row_number + 1 item_in_review = Sheet1.Range("A" & row_number) Dim mail_body_message As String Dim full_name As String Dim exam_grade As String mail_body_message = Sheet1.Range("G3") full_name = Sheet1.Range("B" & row_number) & " " & Sheet1.Range("C" & row_number) exam_grade = Sheet1.Range("D" & row_number) mail_body_message = Replace(mail_body_message, "replace_name_here", full_name) mail_body_message = Replace(mail_body_message, "exam_grade_replace", exam_grade) Call SendEmail(Sheet1.Range("A" & row_number), "Final Year Exam Results", mail_body_message) Loop Until item_in_review = "" MsgBox "The Email Sending Process Is Complete!" End Sub 

编辑 … SendEmail子。

 Sub SendEmail(what_address As String, subject_line As String, mail_body As String) Dim olApp As Outlook.Application Set olApp = CreateObject("Outlook.Application") Dim olMail As Outlook.MailItem Set olMail = olApp.CreateItem(olMailItem) olMail.To = what_address olMail.Subject = subject_line olMail.Body = mail_body olMail.Send End Sub 

基本上发生了什么是它发送列表中的所有电子邮件,但当它击中最后一个空单元它会引发运行时错误,我相信这是因为没有电子邮件地址在最后一个空单元发送到。 那么有没有人知道我到底能如何让它停止?

尝试:

 Sub SendMassEmail() row_number = 1 item_in_review = Sheet1.Range("A" & row_number) Do Until item_in_review = "" DoEvents Dim mail_body_message As String Dim full_name As String Dim exam_grade As String mail_body_message = Sheet1.Range("G3") full_name = Sheet1.Range("B" & row_number) & " " & Sheet1.Range("C" & row_number) exam_grade = Sheet1.Range("D" & row_number) mail_body_message = Replace(mail_body_message, "replace_name_here", full_name) mail_body_message = Replace(mail_body_message, "exam_grade_replace", exam_grade) Call SendEmail(Sheet1.Range("A" & row_number), "Final Year Exam Results", mail_body_message) row_number = row_number + 1 item_in_review = Sheet1.Range("A" & row_number) ' This is the new line Loop MsgBox "The Email Sending Process Is Complete!" End Sub 

我已经将“直到直到”改为“直到直到” – 你的程序试图在“做”和“直到直到”之间运行完整的代码,当你真的希望在你的标准(item_in_review =“ “)被满足了 – 通过testing循环input前的位置来达到这个目的。

在连续范围内查找最后一个单元格的最简单方法是Range.End(xlDown)。 Range.End(xlDown).row你会给这个单元格的行索引。

 Sub SendMassEmail() For each row in Sheet1.Range("A" & Sheet1.Range("A1").End(xlDown).row) item_in_review = Sheet1.Range("A" & row.row) Dim mail_body_message As String Dim full_name As String Dim exam_grade As String mail_body_message = Sheet1.Range("G3") full_name = Sheet1.Range("B" & row.row) & " " & Sheet1.Range("C" & row.row) exam_grade = Sheet1.Range("D" & row.row) mail_body_message = Replace(mail_body_message, "replace_name_here", full_name) mail_body_message = Replace(mail_body_message, "exam_grade_replace", exam_grade) Call SendEmail(Sheet1.Range("A" & row.row), "Final Year Exam Results", mail_body_message) Next row MsgBox "The Email Sending Process Is Complete!" End Sub