Actions list email reminders

Hi,

I've been looking to send out reminders automatically from my Action Tracker spreadsheet to all actionees. I assumed this would be a common use of excel and that I would be able to find a piece of code that I could then bastardise. That much was true but can't seem to make the code work at all as it seems most of the code has been written for a 64bit Excel but we run 32bit Excel.

Would you be able to help convert the code to 32bit? Please find code below.

Many thanks,

John



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