Email To-Do list to Team members in One Click using Excel VBA

In this blog, we will discuss how to email To-Do list from your outlook mail to respective team members. You would have sent email from outlook but probably not using Excel VBA Code.

For example, you have a To-Do list in your excel file with tasks assigned to each team member and you need to send emails with the assigned task to all your team members. If you do it manually then you need to apply a filter and choose team member’s task one by one and then paste in another sheet and then change the format of the database you have copied and finally need to paste the date in your email.

Let’s look at the example. Assume you have the database like below:

Database Picture-1(Picture 1)

From the above picture, you can understand that there are some tasks are defined in a To-Do list. A task should be assigned to a person with a start date and due date.

Now if you do it manually you will apply a filter on your name column and then copy the data and paste it another sheet which should look like below:

Database Picture-2(Picture 2)

Then after manually doing this you can copy the same and paste it in your outlook mail and then you need to send the email.
Database Picture-3(Picture 3)

Now you have done for only 1 employee. You need to do the same for other employees also. Now think if you need to send the task to 50 team members then you will have to do the task for 50 times.

At the same time, a small piece of code will do the task for you. You don’t have to be a programmer to do the same. All you need to know is Where and How to paste the code to run that Excel VBA code.

Follow the below steps to do it automatically:

    1. Press Alt + F11 to go to VBA page
    2. Click on Insert and then Module
    3. Copy the below code and paste the Module
    4. Press F5 to run the code
Sub ExtractDataandsendemail()

Sheets("PullData").Visible = xlSheetVisible

Dim ws     As Worksheet

Dim wsNew  As Worksheet

Dim rData  As Range

Dim rfl    As Range

Dim prsn  As String

Set ws = ThisWorkbook.Sheets("data")

Application.DisplayAlerts = False

With ws

Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 9).End(xlUp))

.Columns(.Columns.Count).Clear

.Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))

prsn = rfl.Text

Sheets("PullData").Select

Range("E5:P200").Select

Selection.ClearContents

Range("E5").Select

rData.AutoFilter Field:=2, Criteria1:=prsn

rData.Copy Destination:=Worksheets("PullData").Cells(5, 5)

Sheets("Pulldata").Select

Range("E:E,H:H,L:L,M:M").Select

Selection.delete Shift:=xlToLeft

Range("E5").Select

Columns("G:G").Select

Selection.Insert Shift:=xlToRight

Selection.Insert Shift:=xlToRight

Range("I5").Select

Call send_email_via_outlook

Next rfl

End With

ws.Columns(Columns.Count).ClearContents

rData.AutoFilter

Sheets("PullData").Visible = xlVeryHidden

Application.DisplayAlerts = True

End Sub



Sub send_email_via_outlook()



' Tools - Refrence - Microsoft Outlook

Dim olApp As New Outlook.Application

Dim olMail As MailItem

Dim email As String

Dim name As String

email = CStr(ThisWorkbook.Sheets("PullData").Range("F6").Value)

name = CStr(ThisWorkbook.Sheets("PullData").Range("E6").Value)

Set olMail = olApp.CreateItem(olMailItem) 

With olMail

.To = email

.CC = ""

.Subject = "Task list for " & name '<br> used to insert a line ( press enter)

.HTMLBody = "Please find the Task below <br><br> " & _

create_table(Sheets("PullData").Range("K6").CurrentRegion) & _

"</Table><br> <br>Regards<br> Yoda Learning"

.Display

.Send

End With

End Sub

 

Function create_table(rng As Range) As String

 

Dim mbody As String

Dim mbody1  As String

Dim i As Long

Dim j As Long

 

mbody = "<TABLE width=""30%"" Border=""1"", Cellspacing=""0""><TR>"

 

For i = 1 To rng.Columns.Count

mbody = mbody & "<TD width=""100"", Bgcolor=""#A52A2A"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:18px"">" & rng.Cells(1, i).Value & "&nbsp;</p></Font></TD>"

Next

 

' add data to the table

For i = 2 To rng.Rows.Count

mbody = mbody & "<TR>"

mbody1 = ""

For j = 1 To rng.Columns.Count

mbody1 = mbody1 & "<TD><center>" & rng.Cells(i, j).Value & "</TD>"

Next

mbody = mbody & mbody1 & "</TR>"

Next

 

create_table = mbody

End Function

Note: Please note that after pasting the code in the module and before running the code click on.

Tools –  References…

Refrence Picture-4(Picture 4)

Then choose Microsoft outlook15.0 Object Library.

Refrences VBA Project Picture-5(Picture 5)

After setting this, please press OK and then press F5 to run the code.

You will see it will send emails to all the team members automatically with their respective subject line.

Please download the file from here and play with it.

I hope you found our article useful. Also if you any doubts or questions regarding this article, feel free to post them in the comment section below.