循环直到Excel

时间:2014-04-30 14:43:15

标签: excel vba loops

您好我正在尝试循环,直到它找到最后一个单元格然后停止但是当它到达空单元格时它会给我一个错误,因为没有人在最后一个空单元格中发送电子邮件。我会复制我的代码,这样你就可以理解我的意思了。

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

基本上发生的事情是它发送列表中的所有电子邮件,但是当它击中最后一个为空的单元格时会抛出运行时错误,我相信这是因为最后一个空单元格中没有要发送的电子邮件地址至。所以有人知道如何在它到达终点时让它停止吗?

2 个答案:

答案 0 :(得分:3)

尝试:

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

我已经改变了" Loop Until" to" Do Until" - 你的程序试图在" Do"之间运行完整的代码。和"循环直到",当你的标准(item_in_review ="")得到满足时你真的希望它停止 - 你通过在输入循环之前测试位置来实现这一点

答案 1 :(得分:0)

在连续范围内查找最后一个单元格的最简单方法是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