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>
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>
