Sending Mails Automatically

[ygsunilkumar]

Hi, My requirement is in excel sheet there are 3 columns as ID, NAME, EMAILID. I need macro for automatically sending the emails to all the persons present in the EMAILID column, number of email id's mary vary.

Email has to be sent with the default message as "Today Please sign off the document" with the subject "Sign the document"

Please find the the excel sheet for reference and do let me know need any clarification.

Thanks in Advance.

[lucas]

See this thread (http://www.vbaexpress.com/forum/showthread.php?t=30891&highlight=email)

Post #19 specifically

[ygsunilkumar]

Lucas, the Post #19 specifically matches my requirement but only thing is "DistributionList" must be Unique/Distinct why becoz i have many mailing list where it repeats more than one. can you please help me on this?

Thanks in Advance.



Option Explicit

Sub eMailClassmates()
Dim OL As Object 'Outlook.Application
Dim EmailItem As Object 'MailItem
Dim Wb As Workbook
Dim strRecipList As String

strRecipList = DistributionList

If strRecipList = vbNullString Then
MsgBox "No list of recipients was created; not mail msg created...", 0, vbNullString
Exit Sub
End If

Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(0) 'olMailItem

With EmailItem
.Subject = "Notice to Alumni!"
'.Body = "Insert message here" & vbCrLf & _
'"Line 2" & vbCrLf & _
'"Line 3"
.To = "Classmates <someone@mailinator.com>"
.BCC = strRecipList
.Importance = 2 'olImportanceHigh 'Or olImprotanceNormal Or olImprotanceLow
'// If needed? //
'.Recipients.ResolveAll
.Display
' .Send
End With

Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub

Function DistributionList() As String
Dim _
wks As Worksheet, _
rngLRow As Range, _
strDistributionList As String, _
rngEmailAddresses As Range, _
rCell As Range

Set wks = ThisWorkbook.Worksheets("MyContacts") 'Change worksheet as needed
Set rngLRow = RangeFound(wks.Range("O3:O" & Rows.Count)) 'Change range as needed

If rngLRow Is Nothing Then
DistributionList = vbNullString
Exit Function
End If

Set rngEmailAddresses = Range(wks.Range("O3"), rngLRow).SpecialCells(xlCellTypeVisible) 'Change range as needed.

For Each rCell In rngEmailAddresses
If Not rCell.Value = vbNullString Then
strDistributionList = strDistributionList & rCell.Value & "; "
End If
Next

DistributionList = IIf(Len(strDistributionList) > 3, _
Left$(strDistributionList, Len(strDistributionList) - 2), _
vbNullString)
End Function

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

[GTO]

Greetings ygsunilkumar,


Lucas, the Post #19 specifically matches my requirement but only thing is "DistributionList" must be Unique/Distinct why becoz i have many mailing list where it repeats more than one. can you please help me on this?

...

I admit that I did not read line-by-line, but it appears to me that you copied the code verbatim, from the link provided by Steve (Lucas).

You mention that it matches your goal, but how did you test? The example you provided shows email addresses in Col C (rather than Col O in the code posted).

If you adjust the code for the correct column, I think you should be able to filter on uniques (in place), as the code only builds addresses from visible rows.

Hope that helps,

Mark

[ygsunilkumar]

You are right, I have the adjusted the code for the correct column but mail listing contains duplicate emaild's because record exists for those. I don't want manually filter on uniques automatically the macro code should take care of it and then send unique emails. Please help

Can any help to get unique email list from the below code. Many Thanks.


Function DistributionList() As String
Dim _
wks As Worksheet, _
rngLRow As Range, _
strDistributionList As String, _
aryEmailAddresses As Variant, _
a As Variant

Set wks = ThisWorkbook.Worksheets("MyContacts") 'Change worksheet as needed
Set rngLRow = RangeFound(wks.Range("O3:O" & Rows.Count)) 'Change range as needed

If rngLRow Is Nothing Then
DistributionList = vbNullString
Exit Function
End If

aryEmailAddresses = Range(wks.Range("O3"), rngLRow).Value 'Change range as needed.

For Each a In aryEmailAddresses
If Not a = vbNullString Then
strDistributionList = strDistributionList & a & "; "
End If
Next

DistributionList = IIf(Len(strDistributionList) > 3, _
Left$(strDistributionList, Len(strDistributionList) - 2), _
vbNullString)
End Function

[Aussiebear]

Construct two lists perhaps?

[ygsunilkumar]

Hi, I worked on the code for unique email list but now I want to display some of the data from the Output tab sheet and please refer the Email Body tab sheet, how the data has to be sent in the Body of the Message. How do I achieve it? Please help.

Thanks in Advance.

[lucas]

ygsunilkumar, you can get a unique list by using the following code. You might put it in a module and call it from the other one or you might incorporate it into the existing code.

What this does as it is currently set up is look at column A and returns a unique list to column B. Adjust as needed.

Dim oUniques As Collection
Dim cell As Range
Dim i As Long
Set oUniques = New Collection
On Error Resume Next
'start looking for unique items starting in cell A3
For Each cell In Range("a3:A1103")
oUniques.Add CStr(cell.Value), CStr(cell.Value)
Next
On Error GoTo 0

For i = 1 To oUniques.Count
'offset the list of unique items to column B
Cells(i, "B").Value = oUniques(i)
Next i


Try to work this out for yourself so you will understand what is going on. If you run into problems, post back here with your issue.

[lucas]

sending range in body. Here's an example:
Bk is set as the activeworkbook like this:

Set Bk = ActiveWorkbook

.Body = "Sheet1" & vbCrLf & "T1: " & Bk.Sheets("Sheet1").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet1").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet1").Range("K3").Value & vbCrLf & vbCrLf & _
"Sheet2" & vbCrLf & "T1: " & Bk.Sheets("Sheet2").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet2").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet2").Range("K3").Value & vbCrLf & vbCrLf & _
"Sheet3" & vbCrLf & "T1: " & Bk.Sheets("Sheet3").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet3").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet3").Range("K3").Value

[ygsunilkumar]

Thansk Lucas, actually the below code is just taking one cell value but i need how many rows value present in column A based on it selected range of values to be sent.

For example: Column A rows are till "A50" then code should be able to send those 50 rows or range of data should be sent. Please help.

Thanks in advance.




.Body = "Sheet1" & vbCrLf & "T1: " & Bk.Sheets("Sheet1").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet1").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet1").Range("K3").Value & vbCrLf & vbCrLf & _
"Sheet2" & vbCrLf & "T1: " & Bk.Sheets("Sheet2").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet2").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet2").Range("K3").Value & vbCrLf & vbCrLf & _
"Sheet3" & vbCrLf & "T1: " & Bk.Sheets("Sheet3").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet3").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet3").Range("K3").Value

[lucas]

This will create an htm file in a directory c:\temp which you must create.

If you don't have a c drive, you will have to change it in the code.

See attached example.

This is the only way I know to do this.

[ygsunilkumar]

Lucas, actually your code of htm file is not working for me. Getting error as Type Mismatch.

Is there any alternative code and which also counts the number of rows in the column A and that many number of data should go the mail.

Thanks in Advance.

[GTO]

Lucas, actually your code of htm file is not working for me. Getting error as Type Mismatch.

I just ran Steve's code, no hitches. Currently in XL2003, XP, WIN.


Is there any alternative code and which also counts the number of rows in the column A and that many number of data should go the mail...

In column A of Steve's example is the class year. What are you asking in the bolded part?

Regardless of the answer to that last bit, I would suggest you attach your wb, with the code as you have it, providing fake info that accurately portrays the actual info, where actual info is sensitive.

Mark

[lucas]

did you create a c:\Temp folder

[ygsunilkumar]

Hi, My requirement is slighly changed now, Mail has to be sent individually to the person based on the email address and details based on the SEQNO(column A).

In this case, the mail has to go for 3 persons (3 mails) and also data based on SEQNO. Here EMAIL_ADDRESS and SEQNO are distinct/unique.

Please refer the EXAMPLE_EMAIL excel sheet attached, "Data" tab sheet contains my raw data and "Email Body" is desired output how it has to go in the mail.

Please let me know you need any further information. Thanks in Advance.

[lucas]

Hi, My requirement is slighly changed now, Mail has to be sent individually to the person based on the email address and details based on the SEQNO(column A).



Slightly?

based on what exactly?

More details needed and you need to figure out what you want to do exactly.

Also did you get the other file to work for you? It would be nice if you could give some feedback so we will know where we are with this.

[ygsunilkumar]

Also did you get the other file to work for you? It would be nice if you could give some feedback so we will know where we are with this: Yes, I got it but earlier the requirement is to send mail as Distribution List and now requirement has been changed it, mail has to be send individually.

These are the steps which I required the code has to do.

1. From the raw data that is "Data" Sheet based on "EMAIL_ADDRESS" rest of the data has to be sorted(SEQNO, CODE, CLIENT,PROJDB, REQ, REQTYPE, PARTB_PL, REQ_DET).
2. After sorting data, it should total the "SEQNO" for each "EMAIL_ADDRESS"
3. Email should be send individually along with the details like (EMAIL_ADDRESS, SEQNO, CODE, CLIENT, PROJDB, REQ, REQTYPE, PARTB_PL, REQ_DET).

Please go through once again the EXAMPLE_EMAIL worksheet. It contains raw data and expected output.

Thanks in advance.

[ygsunilkumar]

Hi, Please help me anyone. Thanks

[ygsunilkumar]

Hi, Any one please help, I need this very urgent.

If you need any more information will provide you. Thanks in advance

[ygsunilkumar]

hi, i think no one wants to help me:banghead: , i need it very urgently.

Thanks in Advance.