在带有 VBA 的 Excel 上，如何将邮件发送到一封包含 Excel 信息的电子邮件

Question

我希望从这段代码中得到一个代码，它针对每个不同的电子邮件（我的 Excel 表的第 12 列）恢复第 1、2 和 3 列的值，并将它们放入邮件正文中，第 1 列是合作伙伴列 2 RAA 和 3 ID。有必要考虑到，如果邮件在 Excel 中出现 2 次，它会为合作伙伴列出 RAA 和 ID。

目前我得到这样的东西：

Hello, 
we are doing some users (ulogin) cleaning for partners. 
We have identified the following users for which you are the owner : 
Partner name: XXX | RAA: 001 | ID: 002 
Please gave us some feedback on those users which did not connect in 
more than 20 mounths or never sometimes. 
If we get no feed back from you, we will initiate removal of those users. 
Best regards,  

如果所有者只有一个合作伙伴名称，这是正确的，但在我的代码中，即使他获得 2 个合作伙伴名称、2 个 RAA 和 2 个 ID 或更多，我也会得到这个。当我在 excel 中收到 2 次相同的电子邮件（所有者）时，我想得到这样的东西：

Hello, 
we are doing some users (ulogin) cleaning for partners. 
We have identified the following users for which you are the owner : 
Partner name: XXX, AAA | RAA: 001,012 | ID: 002,341
Please gave us some feedback on those users which did not connect in 
more than 20 mounths or never sometimes. 
If we get no feed back from you, we will initiate removal of those users. 
Best regards,  

我希望我清楚谢谢你帮助我

Private Sub CommandButton1_Click()
  Dim sh As Worksheet, lastRQ As Long, arr, arrUs, i As Long, j As Long
  Dim mail As Object, strUsers As String, dict As Object
  Set sh = ActiveSheet
  lastRQ = sh.Range("AA" & sh.Rows.Count).End(xlUp).Row 'last row on AA:AA
  arr = sh.Range("A2:AA" & lastRQ).Value 'place the range in an array for faster processing
  'Place the necessary data in the dictionary:
  Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
  For i = 1 To UBound(arr)
    If arr(i, 27) = "to do" Then
      If Not dict.Exists(arr(i, 9)) Then
        dict.Add arr(i, 9), arr(i, 2) & " / " & arr(i, 3) & " / " & arr(i, 1) & " / " & arr(i, 4)
      Else
        dict(arr(i, 9)) = dict(arr(i, 9)) & " / " & arr(i, 1) & " / " & arr(i, 2) & " / " & arr(i, 3) & " / " & arr(i, 4)
      End If
    End If
  Next i
  Set mail = CreateObject("Outlook.Application") 'create an outlook object
  'extract the necessary data:
  For i = 0 To dict.Count - 1
    arr = Split(dict.Items()(i), " / ") 'split the item by " / " to extract values
    arrUs = Split(arr(3), " / ")

    If UBound(arrUs) > 0 Then
      'get the RAA, ID and partner name for each user
      strUsers = ""
      For j = 0 To UBound(arrUs)
        strUsers = strUsers & "Partner name: " & arrUs(j) & " | RAA: " & arr(0) & " | ID: " & arr(2) & Chr(13) & Chr(10)
      Next j
      strUsers = strUsers & "Please gave us some feedback on those users which did not connect in more than 20 mounths or never sometimes." & Chr(13) & Chr(10) & "If we get no feed back from you, we will initiate removal of those users. " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Best regards," & Chr(10) & "xxx"
    Else
      strUsers = "Partner name: " & arr(1) & " | RAA: " & arr(0) & " | ID: " & arr(2) & Chr(13) & Chr(10) & "Please gave us some feedback on those users which did not connect in more than 20 mounths or never sometimes." & Chr(13) & Chr(10) & "If we get no feed back from you, we will initiate removal of those users. " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Best regards," & Chr(10) & "xxx"
    End If
    With mail.CreateItem(olMailItem)
      .Subject = "Ulogin cleaning - Never connected or not since more than 20+ months"
      .To = dict.Keys()(i)
      .CC = "xxx@gmail.com"
      .Body = "Hello," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "we are doing some users (ulogin) cleaning for partners." & Chr(13) & Chr(10) & "We have identified the following users for which you are the owner : " & strUsers
      .Display ' See the New mail in Outlook and check its contents
    End With
  Next i
End Sub

Answer 1

谢谢你，我继续努力，我找到了做我想做的事的方法！

Private Sub CommandButton1_Click()
  Dim sh As Worksheet, lastRQ As Long, arr, i As Long, j As Long
  Dim mail As Object, strUsers As String, dict As Object
  Set sh = ActiveSheet
  lastRQ = sh.Range("AA" & sh.Rows.Count).End(xlUp).Row 'last row on AA:AA
  arr = sh.Range("A2:AA" & lastRQ).Value 'place the range in an array for faster processing
  'Place the necessary data in the dictionary:
  Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
  For i = 1 To UBound(arr)
    If arr(i, 27) = "to do" Then
      If Not dict.Exists(arr(i, 12)) Then
        dict.Add arr(i, 12), "Partenaire: " & arr(i, 3) & " | RAA: " & arr(i, 2) & " | ID: " & arr(i, 1)
      Else
        dict(arr(i, 12)) = dict(arr(i, 12)) & " / " & "Partenaire: " & arr(i, 3) & " | RAA: " & arr(i, 2) & " | ID: " & arr(i, 1)
      End If
    End If
  Next i
  Set mail = CreateObject("Outlook.Application") 'create an outlook object
  'extract the necessary data:
  For i = 0 To dict.Count - 1
    strUsers = dict.Items()(i)
    With mail.CreateItem(olMailItem)
    .Subject = "Ulogin cleaning - Never connected or not since more than 20+ months"
    .To = dict.Keys()(i)
    .CC = "xxx@gmail.com"
    .Body = "Hello," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "we are doing some users (ulogin) cleaning for partners." & Chr(13) & Chr(10) & "We have identified the following users for which you are the owner : " & strUsers
    .Display ' See the New mail in Outlook and check its contents
    End With
  Next i
End Sub