Insert Range in to Outlook email body from excel VBA

[JasonEnsor]

Hi Guys,

I seem to live on this site at the moment, once again i am sure it is something simple that i am missing. The code below compares a list of unique names on TutorList against a list of student sickness notifications. The aim is to create one email per tutor listing all of the sickness recieved for them from the students.

Data comes in the format of (Columns A - J) in worksheet "Notifications"
Tutor Name, Student Forename, Student Surname, Student Id, Programme, Stage, Absence Started, Expected Date of return, module code, Module Title

Currently i can declare a variable for each column and paste it as part of the email body. So every every tutor only gets 1 email. I am wondering if it is possible to copy and past the range ("A"& currentRow : "J" & currentRow) it to the email body, then make the email body = email body + new body (code example makes it clearer that my explanation)

Public Sub Test()

Dim absence As Range
Dim tutor As Range

Dim Notifications As Worksheet
Dim TutorList As Worksheet
Dim lastRow As Long

Dim nCurrentRow As Long
Dim tCurrentRow As Long

Dim NTutorName As String
Dim TutorName As String
Dim NStudentName As String

Dim NotifyLastRow
Dim TutorLastRow

Dim OutlookApp As Object
Dim MItem As Object
Dim Msg

Set Notifications = ActiveWorkbook.Sheets("Notifications")
Set TutorList = ActiveWorkbook.Sheets("TutorNames")
Set OutlookApp = CreateObject("Outlook.Application")

      NotifyLastRow = ActiveWorkbook.Sheets("Notifications").Cells(Rows.Count, 1).End(xlUp).row
      TutorLastRow = ActiveWorkbook.Sheets("TutorNames").Cells(Rows.Count, 1).End(xlUp).row

      TutorList.Activate
      
      For Each tutor In TutorList.Range("A2:A" & TutorLastRow)
         
         tutor.Rows.EntireRow.Select
         tCurrentRow = ActiveCell.row
         TutorName = TutorList.Cells.Range("A" & tCurrentRow).Value
         Set MItem = OutlookApp.CreateItem(0)

         Notifications.Activate
         
         For Each absence In Notifications.Range("A2:A" & NotifyLastRow)
         
            absence.Rows.EntireRow.Select
            nCurrentRow = ActiveCell.row
            
            ' Want to copy Columns A to J
            NTutorName = Notifications.Cells.Range("A" & nCurrentRow).Value
            NStudentName = Notifications.Cells.Range("B" & nCurrentRow).Value
            NStudentSurname = Notifications.Cells.Range("C" & nCurrentRow).Value
            NStudentID = Notifications.Cells.Range("D" & nCurrentRow).Value
         
            If (StrComp(NTutorName, TutorName, vbTextCompare) = 0) Then
                Msg = Msg & "Name: " & NStudentName & vbCr
             
                With MItem
                  .Body = Msg
                  .Display
               End With
            End If
         Next absence
         
         Msg = ""
         TutorList.Activate
      Next tutor
End Sub

Any thoughts or pointers as to what i should be looking for?

Regards

Jason

 

[ClulessChris]

Could you not loop through the columns to create a 'delimited' list, then 'paste' that?

Never knock on Death's door: ring the bell and run away! Death really hates that!