我想从这个代码的代码，为每个不同的电子邮件(我的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次相同的邮件(owner):
时，我想得到这样的东西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
谢谢你，我在工作，我发现如何做我想要的!
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