[英]On Excel with VBA how to send an mail to one email with excel information in it
I would like that from this code a code that for each different emails (column 12 of my Excel table) it recovers the values of the columns 1, 2 and 3 and puts them in the body of the mails with for the column 1 the partners the column 2 RAA and the 3 ID.我希望从这段代码中得到一个代码,它针对每个不同的电子邮件(我的 Excel 表的第 12 列)恢复第 1、2 和 3 列的值,并将它们放入邮件正文中,第 1 列是合作伙伴列 2 RAA 和 3 ID。 It is necessary to take into account that if the mails is 2 times in the Excel it makes a list for the partners the RAA and ID.
有必要考虑到,如果邮件在 Excel 中出现 2 次,它会为合作伙伴列出 RAA 和 ID。
For the moment I get something like that:目前我得到这样的东西:
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,
This is correct if the owner have only one partner name but in my code I get this even if he get 2 Partner name 2 RAA and 2 ID or more.如果所有者只有一个合作伙伴名称,这是正确的,但在我的代码中,即使他获得 2 个合作伙伴名称、2 个 RAA 和 2 个 ID 或更多,我也会得到这个。 and I want get something like this when in my excel I get 2 time the same email (owner):
我想在我的 excel 中得到这样的东西,我得到 2 次相同的 email(所有者):
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,
I hope I am clear thank you for helping me我希望我清楚谢谢你帮助我
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
Thank you I work on in and I find how to do what I wanted !谢谢你,我继续努力,我找到了做我想做的事的方法!
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.