Excel VBA宏根據單元值發送多個附件

Question

我是VBA的初學者，並且正在處理宏以自動執行報告。基本上，宏通過一個電子表格，每行代表一個不同的客戶端。第三列包含客戶端名稱，第四列包含花費金額，第五列爲收件人的電子郵件地址，第六列和第七列包含完整報告的部分文件路徑。

如果你想爲每一行生成一個電子郵件，但是現在我想讓它生成包含來自多行信息的電子郵件，它工作正常。我的想法是，我將在第2列中爲每封電子郵件分配一個唯一的ID，並且如果該行與之前的行具有相同的唯一ID，它將跳過生成電子郵件，但它將包括來自第4列的數字以及對於與該唯一ID相等的所有後續行，第6和第7列中的文件路徑基於附件。例如，如果第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