Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Create personalised email using multiple rows of data using excel 2010, vba and outlook

Status
Not open for further replies.

JasonEnsor

Programmer
Sep 14, 2010
193
GB
Hi Guys,

I hope the title explains my problem a little, i always struggle trying to think of a relevant title...anyways I currently have an Excel spreadsheet which i am using to send personalised emails from using VBA, They hold information regarding a students id, students name and sickness details. However the academics are sometimes getting multiple emails depending on how many of there students are off sick. What i am wanting to do is collate all the students information for an academic then send that on one email instead of multiple.

An example would be
Academic Name | Student Id | Student Name | Sickness Info
---------------------------------------------------------
Tutor 1 123456789 Joe Bloggs Cold
Tutor 1 258791341 Tom Jones Flu
Tutor 2 248978953 Bob Someone Broken Arm

So two emails will be generated, one to Tutor 1 with 2 students listed and 1 for Tutor 2.

The example below is what i am using to notify students that academics have reported there absence, i am assuming a few tweaks to this code might work but i am at a loss as to where to start really.

Code:
Sub Send_Attendance_First_Notification_Email()

Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String

Dim p1 As Long, p2 As Long
Dim first_nameP As String
Dim last_nameP As String
Dim idP As String
Dim catalogP As String
Dim descr1P As String

Dim first_name As String
Dim last_name As String
Dim id As String
Dim catalog As String
Dim descr1 As String

first_nameP = "!First_Name!"
last_nameP = "!Last!"
idP = "!ID!"
catalogP = "!Catalog!"
descr1P = "!Descr1!"

Set OutlookApp = CreateObject("Outlook.Application")
Dim oItem As Object

    For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
    
            If cell.Value Like "*@*" Then
                
                descr1 = cell.Offset(0, 2).Value
                catalog = cell.Offset(0, -4).Value
                first_name = cell.Offset(0, -5).Value
                last_name = cell.Offset(0, -6).Value
                id = cell.Offset(0, -7).Value
                
                
                Subj = id & " - Attendance Notification" & " " & catalog
                
                EmailAddress = cell.Value
                
                Set oItem = OutlookApp.CreateItemFromTemplate("S:\SSIS\PAS\Attendance Mon\Email Templates\First_Notification.oft")

 ' Replace all placeholders in the email
                p1 = InStr(oItem.Body, first_nameP)
                
                If p1 > 0 Then
                    p2 = p1 + Len(first_nameP)
                        oItem.Body = Left(oItem.Body, p1 - 1) & first_name & Mid(oItem.Body, p2)
                    p1 = 0
               End If
                
                p1 = InStr(oItem.Body, last_nameP)
                If p1 > 0 Then
                    p2 = p1 + Len(last_nameP)
                        oItem.Body = Left(oItem.Body, p1 - 1) & last_name & Mid(oItem.Body, p2)
                        p1 = 0
                End If

                p1 = InStr(oItem.Body, idP)
                If p1 > 0 Then
                    p2 = p1 + Len(idP)
                        oItem.Body = Left(oItem.Body, p1 - 1) & id & Mid(oItem.Body, p2)
                        p1 = 0
                End If

                p1 = InStr(oItem.Body, catalogP)
                If p1 > 0 Then
                    p2 = p1 + Len(catalogP)
                        oItem.Body = Left(oItem.Body, p1 - 1) & catalog & Mid(oItem.Body, p2)
                        p1 = 0
                End If

                p1 = InStr(oItem.Body, descr1P)
                If p1 > 0 Then
                    p2 = p1 + Len(descr1P)
                        oItem.Body = Left(oItem.Body, p1 - 1) & descr1 & Mid(oItem.Body, p2)
                        p1 = 0
                End If
                  
                oItem.SentOnBehalfOfName = "Attendance Monitoring"
                oItem.To = EmailAddress
                oItem.Subject = Subj
                oItem.Display
                
' Add entry to logfile
                AttendanceLogFile (id & " " & catalog)
            End If
    Next
End Sub

Any help or advice would be appreciated

Regards

J

 
You could import the XLS into temp table, allowing you to sort by Tutor using SQL, then loop the recordset concatenating student details to a string, which is used for the single email sent to Tutor each time the Tutor changes.

Or use a collection object to collate students into Tutor groups from the spreadsheet and then process the collection for sending the email.

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Hey,

Thanks for the suggestion, not 100% sure about the SQL method, my SQL skills are almost non-existent. I will look in to using collections and see how that pans out.

Regards

J.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top