Excel VBA help to create outlook emails

[rodeo]

Hi,

I am trying to create an outlook email for multiple recipients.

I have 2 sheets 1 and 2.

I want the code in sheet 1 column B to look into Sheet 2 column A and pick up all the email addresses matched the codes and create an email with list recipients in tostring and do repeat task for second code till its empty.

Also attach files corresponding to that code in column c in sheet 1.

I have created a below code but not sure how to create a tostring in VBA with multiple recipients.



Sub GenerateEmail()
i = 2 ' selects row 2 ,since row 1 ,i am keeping for titles
Dim wbBook As Excel.Workbook
Dim doText As DataObject
Dim wsSheet As Excel.Worksheet
Dim x As Variant
Dim myemail As String
Dim myrange As Range
Dim n As Range
Dim sm2 As Range




Set wbBook = ThisWorkbook
Set sm2 = ThisWorkbook.Sheets("Sheet 2").Range("A2:A1000")
Set sm1 = ThisWorkbook.Sheets("Sheet 1").Range("B2:B1000")



Do Until ThisWorkbook.Sheets("Sheet 1").Cells(i, "B").Value = ""


EmailTo = tostring


BCC = ThisWorkbook.Sheets("Sheet 1").Range("J3").Value
Subj = ThisWorkbook.Sheets("Sheet 1").Range("J4").Value
Path = "N:\Folder 1\Folder 2\Folder 3\Folder 3\Result\"
FileName = ThisWorkbook.Sheets("Sheet 1").Cells(i, 3)
SM = ThisWorkbook.Sheets("Sheet 1").Cells(i, 2)




x = Replace(Range("Content1").Value, "
", Format(Range("GenerationMonth").Value, "mmmm"))
x = x & Replace(Range("Content2").Value, "
", Format(Range("GenerationMonth").Value, "mmmm-yyyy"))
x = x & ThisWorkbook.Sheets("Sheet 3").Range("Content3").Value
Msg = x






Application.ScreenUpdating = False
Application.StatusBar = "Preparing email..."
Application.DisplayAlerts = False



'Variables for MS Outlook.
'Variables for MS Outlook.






Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = "Cleint1@Hotmail.com"
.To = EmailTo
.BCC = "Cleint1@Hotmail.com"
.Subject = "This is my subject" & Format(DateAdd("m", -1, Date), "mmmm yyyy")
.Attachments.Add Path & FileName
.Display
.BodyFormat = olFormatPlain
.Body = Msg
'send
End With
i = i + 1
Set doText = Nothing
Application.CutCopyMode = False


Loop


Cells(7, "J").Value = "Outlook msg count =" & i - 1

Set OutMail = Nothing
Set OutApp = Nothing

Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Workbooks(MyFile).Close




End Sub</projection></projection>

 

[Macropod]

Kindly read the forum rules (MrExcel Message Board FAQ). In particular:
•Avoid multiple questions of a similar nature. Duplicate posts by the same user will be locked and/or deleted when found. If the answer you receive is inadequate for some reason, post a reply stating why with more information (if/when needed) in the same thread. Do not start a new topic.

 

[rodeo]

Hi Macropod,

Apologies for duplicate threads...I am new to mrexcel.

Thank you

 

[rodeo]

Should you require any further information, please do let me know.

I need this solved urgently.

Thank you so much everyone.

 

[rodeo]

SHEET 1

client name	Client code	Attachments					Previous Month Date	September 2015
Ab 1	Client 1	Client 1 RESULT Sep-15.zip					Email Count
CD 2	Client 2	Client 2 RESULT Sep-15.zip
EF 3	Client 3	Client 3 RESULT Sep-15.zip
GH 4	Client 4	Client 4 RESULT Sep-15.zip
JK 5	Client 5	Client 5 RESULT Sep-15.zip
SHEET 2 SM Codes Name Email (Preferred) Client 1 AB 1 Client 1@HOTMAIL.COM Client 1 AB 1 Client 1@HOTMAIL.COM Client 1 AB 1 Client 1@HOTMAIL.COM Client 1 AB 1 Client 1@HOTMAIL.COM Client 2 CD 2 Client 2@HOTMAIL.COM Client 2 CD 2 Client 2@HOTMAIL.COM Client 2 CD 2 Client 2@HOTMAIL.COM Client 3 EF 3 Client 3@HOTMAIL.COM Client 3 EF 3 Client 3@HOTMAIL.COM Client 4 GH 4 Client 4@HOTMAIL.COM Client 5 JK 5 Client 5@HOTMAIL.COM Client 5 JK 5 Client 5@HOTMAIL.COM <colgroup><col><col><col></colgroup><tbody> </tbody>

<colgroup><col><col><col><col><col span="2"><col><col><col></colgroup><tbody>
</tbody>

 

[rodeo]

Hi,

I am trying to get the below code in the above to create a to string




Lastrow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For Each myrange In Sheets("Sheet2").Range("A2:A" & Lastrow)
If myrange = Sheet1 Then
myemail = myemail & myrange.Offset(0, 4).Value & ";"
End If
Exit For


The problem I am facing is every email it generates it picks up all the email addresses from the previous email generated...

I wanted to generate each email for each client.

your input will be much appreciated.

Thank you