Been some days while I posted something, was busy with official tasks.
This came as a surprise when there was a need to send personalized emails to all new team members when a new team was formed. This is highly motivational and boosts morale.
We will start with basic data that we know of.
Team | Rep | email ID | Lead |
East | Jones | Jones@xyz.com | Jones@xyz.com |
Central | Kivell | Kivell@xyz.com | Kivell@xyz.com |
Central | Jardine | Jardine@xyz.com | Kivell@xyz.com |
Central | Gill | Gill@xyz.com | Kivell@xyz.com |
West | Sorvino | Sorvino@xyz.com | Gill@xyz.com |
East | Jones | Jones@xyz.com | Jones@xyz.com |
Central | Andrews | Andrews@xyz.com | Kivell@xyz.com |
Central | Jardine | Jardine@xyz.com | Kivell@xyz.com |
West | Thompson | Thompson@xyz.com | Gill@xyz.com |
East | Jones | Jones@xyz.com | Jones@xyz.com |
Central | Morgan | Morgan@xyz.com | Kivell@xyz.com |
East | Howard | Howard@xyz.com | Jones@xyz.com |
East | Parent | Parent@xyz.com | Jones@xyz.com |
East | Jones | Jones@xyz.com | Jones@xyz.com |
Central | Smith | Smith@xyz.com | Kivell@xyz.com |
East | Jones | Jones@xyz.com | Jones@xyz.com |
Central | Morgan | Morgan@xyz.com | Kivell@xyz.com |
East | Jones | Jones@xyz.com | Jones@xyz.com |
This is how the email should look like, Replace xxxx, yyyy with your message.
As you see in entire email, only 4 parameters change,
Name, Email id, Lead and team name and these are picked from table
Here is the code, See how this is closely related to other older posts.
Mailing Charts to different employees – VBA / Excel
Mail the Summary – VBA / Excel
‘————————————————————————————–
Sub Mail_From_ActiveRow()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Sourcews As Worksheet
Dim Mailwb As Workbook
Dim Mailws As Worksheet
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim ws As Worksheet
Dim wb As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set Sourcewb = ActiveWorkbook
Set Sourcews = ActiveWorkbook.Worksheets(ActiveSheet.Name)
Name_Col = getColFromAddr(getAddress(Sourcews, “Rep”))
EmailID_Col = getColFromAddr(getAddress(Sourcews, “email ID”))
Team_Col = getColFromAddr(getAddress(Sourcews, “Team”))
Lead_Col = getColFromAddr(getAddress(Sourcews, “Lead”))
myrow = ActiveCell.Row
For Each wb In Application.Workbooks
For Each ws In wb.Worksheets
If ws.Name = “Mail” Then
Set Mailwb = wb
Set Mailws = ws
Exit For
End If
Next
Next
Range(“Salutation_Email”).Value = “Dear ” & Sourcews.Cells(myrow, Name_Col)
ToMailString = Sourcews.Cells(myrow, EmailID_Col)
CCMailString = Sourcews.Cells(myrow, Lead_Col)
SubJectString = Range(“Subject_Email”).Value
Range(“Team_Text”).Value = “I am extremely delighted to welcome you to the ” & Sourcews.Cells(myrow, Team_Col) & _
” team.”
Set rng = Sheets(“Mail”).Range(“Mail”).SpecialCells(xlCellTypeVisible)
Set OutApp = CreateObject(“Outlook.Application”)
Set OutMail = OutApp.CreateItem(0)
With Destwb
On Error Resume Next
With OutMail
‘.SentOnBehalfOfName = “iWFMCLR@csc.com”
.To = ToMailString
.CC = CCMailString
‘.BCC = “”
.Subject = SubJectString
‘.Body = “Hi there”
‘.Attachments.Add Destwb.FullName
.HTMLBody = RangetoHTML(rng)
‘You can add other files also like this
‘.Attachments.Add (“C:\test.txt”)
‘.Send ‘ when you have made mail completely and wnat to send instead of drating.
.Display
End With
On Error GoTo 0
End With
ToMailString = “”
SubJectString = “”
CCMailString = “”
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
‘————————————————————————————–
If you run this macro this will make a draft mail from active cell, Now after you have modified the code to our liking, run this macro
‘————————————————————————————–
Sub Mail_Create()
‘For i = 2 To ActiveSheet.UsedRange.Rows.Count
For i = 2 To 10
If Not ActiveSheet.Cells(i, 1).EntireRow.Hidden Then
Range(“A” & i).Select
Call Mail_From_ActiveRow
End If
Next i
End Sub
‘————————————————————————————–
Here is the code and file to play with.
Cheers
CuriousJatin