使用多个动态单元格引用为每个使用过的行循环子例程

Question

基本上我想做的是，为目标工作表上的每一行发送一封电子邮件，每一行都有详细的地址、主题行、table 和值等

所以我似乎无法让它工作，因为它只从第一个目标行（第二行）发送一封电子邮件。

我试过组合使用 For Each 和 For i = 1 to LR，但没有用。我怀疑这与单元格引用有关。

代码如下：

Sub TestEmail1()
  Application.ScreenUpdating = False

    Dim aOutlook As Object
    Dim aEmail As Object
    Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
    Dim ccAddresses As Range, ccCell As Range, ccRecipients As String
    Dim rngeSubject As Range, SubjectCell As Range, SubjectContent As Variant
    Dim rngeBody As Range, bodyCell As Range, bodyContent As Variant
    Dim Table1 As Range
    Dim i As Integer

    For Each c In ActiveSheet.UsedRange.Columns("A").Cells
      Set rng = ActiveSheet.UsedRange
      LRow = rng.Rows.Count
      For i = 2 To LRow
        Set Table1 = Worksheets(1).Range("K1:R1")
        Set Table2 = Worksheets(2).Range("K" & i & ":" & "R" & i)
        Set aOutlook = CreateObject("Outlook.Application")
        Set aEmail = aOutlook.CreateItem(0)

        'set sheet to find address for e-mails as I have several people to
        'mail to

        Set rngeAddresses = ActiveSheet.Range("B" & i)
        For Each rngeCell In rngeAddresses.Cells
          strRecipients = strRecipients & ";" & rngeCell.Value
        Next

        Set ccAddresses = ActiveSheet.Range("C" & i)
        For Each ccCell In ccAddresses.Cells
          ccRecipients = ccRecipients & ";" & ccCell.Value
        Next

        Set rngeSubject = ActiveSheet.Range("D" & i)
        For Each SubjectCell In rngeSubject.Cells
          SubjectContent = SubjectContent & SubjectCell.Value
        Next

        Set rngeBody = ActiveSheet.Range("E" & i)
        For Each bodyCell In rngeBody.Cells
          bodyContent = bodyContent & bodyCell.Value
        Next

        'set Importance
        'aEmail.Importance = 2
        'Set Subject
        aEmail.Subject = rngeSubject
        'Set Body for mail
        'aEmail.Body = bodyContent
        aEmail.HTMLBody = bodyContent & "<br><br><br>" & RangetoHTML_   (Table1)            
        aEmail.To = strRecipients
        aEmail.CC = ccRecipients
        aEmail.Send
        Exit Sub
      Next i
    Next c
    End Sub

Answer 1

在你的内部循环的末尾有一个 Exit Sub 使代码在第一次迭代后退出过程：

Sub TestEmail1()
  ...
  For Each c In ActiveSheet.UsedRange.Columns("A").Cells
    ...
    For i = 2 To LRow
      ...
      <b>Exit Sub</b>
    Next i
  Next c
End Sub

删除它，处理应该会按需要继续。

使用多个动态单元格引用为每个使用过的行循环子例程

Loop subroutine for every used row using multiple dynamic cell references

email

excel

vba