Question

我是VBA的初学者，我正在开发一个宏来自动化报告。基本上，宏会通过电子表格，其中每行代表不同的客户端。第三列具有客户端名称，第四列具有花费的金额，第五列是收件人的电子邮件地址，第六列和第七列包含完整报告的文件路径的部分。

如果要为每行生成电子邮件，它可以正常工作，但现在我希望它生成包含多行信息的电子邮件。我的想法是，我会在第2列为每封电子邮件分配一个唯一的ID，如果该行与之前的行具有相同的唯一ID，它将跳过生成电子邮件，但它将包括第4列中的数字以及基于第六列和第七列中文件路径的附件，用于等于该唯一ID的所有后续行。例如，如果第2列为1,1,1,2,2,3，则会有3封电子邮件而不是6封。列表总是会被正确排序，所以这不是问题。

我不太确定如何创建嵌套循环，该循环遍历所有后续行，其值与第2列中的第一个单元格相同，然后在第一个循环中忽略它们。我很感激任何建议。

Sub Test1()
Dim rng as Range
Dim OutApp as Object
Dim OutMail as Object
Dim r as Long

Set rng = Nothing
Set rng = ActiveSheet.UsedRange

For r = 2 to 8

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail 
     .To = rng.Cells(r,5).value
     .Subject = rng.Cells(r,3).value & " Report"
      If rng.Cells(r,2).value <> rng.cells.value(r+1,2) Then
            .HTMLBody = "This is how much was spent on the " & rng.Cells(r,3).Value & " account:" & rng.Cells(r,4),value
            .Attachments.Add (rng.Cells(r,6).value & rng.Cells(r,7).value)
      ElseIf rng.Cells(r,2).value = rng.Cells(r+1, 2) Then
            .HTMLBody = "This is how much was spent on the " & rng.Cells(r,3).Value & " account:" & rng.Cells(r,4).value & "</br>" & _
            "This is how much was spent on the " & rng.Cells(r+1,3).Value & " account:" & rng.Cells(r+1,4).value
            .Attachments.Add (rng.Cells(r,6).value & rng.Cells(r,7).value)
            .Attachments.Add (rng.Cells(r+1,6).value & rng.Cells(r+1,7).value)
      Else '
      End If
     .Display

 End With
 Set OutMail = Nothing
 Set OutApp = Nothing

 Next r
 End Sub

Answer 1

按顺序提供第2列中的信息，以下代码应该有效：

Sub Test1()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim r As Long

    Set rng = ActiveSheet.UsedRange

    r = 2

    Set OutApp = CreateObject("Outlook.Application")

    Do While r <= rng.Rows.Count
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = rng.Cells(r, 5).Value
            .Subject = rng.Cells(r, 3).Value & " Report"
            .HTMLBody = "This is how much was spent on the " & rng.Cells(r, 3).Value & " account:" & rng.Cells(r, 4).Value
            .Attachments.Add (rng.Cells(r, 6).Value & rng.Cells(r, 7).Value)
            'See if the next row is for the same client.  If so, process that 
            'row as well.  And then keep doing it until no more rows match
            Do While rng.Cells(r, 2).Value = rng.Cells(r + 1, 2)
                r = r + 1
                .HTMLBody = .HTMLBody & "</br>" & "This is how much was spent on the " & rng.Cells(r, 3).Value & " account:" & rng.Cells(r, 4).Value
                .Attachments.Add (rng.Cells(r, 6).Value & rng.Cells(r, 7).Value)
            Loop
            .Display

        End With
        Set OutMail = Nothing
        r = r + 1
    Loop
    Set OutApp = Nothing

End Sub

Excel VBA宏根据单元格值

1 个答案: