VBScript to populate CDO email with contents of Excel range

[NewOrderFac33]

If anyone's feeling full of festive cheer, maybe you could fling some VBScripting expertise my way, assuming that this falls into the remit of this forum, given that it's based around Excel!

I'm trying to generate an email using CDO that is populated with the values in B4:E8 from a worksheet which contains details of record releases with column B containing Catalogue numbers, C containing the Title, D the year of release and E the B-Side title. In addition, B4:B8 also has the name "Col_DB_CatNo".

At the moment, the code works, except that the resulting email contains the contents of B4:C8 as one continuous string, instead of each record having a line break between them.

Also, if I want to insert spaces, I can't, whether I use strings like " " or use Space(20) - I only get a single space displayed.

I'd be grateful for any pointers to get this up and running.

Thanks in advance and Christmas cheer (mutter, grumble) to all!

Pete

Function GetData()


    Dim x, strTemp, objExcel, objWB, MyString


    Set objExcel = Wscript.CreateObject("Excel.Application") 
    Set objWB = objExcel.Workbooks.Open("c:\PetesStuff\01 backup\00 VB Script\FACWorkbook.xlsx") 
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1) 
    
   'Make Excel visible while debugging 
    objExcel.Visible = True 

'THIS IS WHAT I'D LIKE TO MAKE WORK
'   For Each MyCell In ObjSheet.Range("Col_DB_CatNo")
'    MyString = MyCell.Value & vbCRLF
'   Next
'   MsgBox (MyString)



'THIS IS WHAT PARTIALLY WORKS
   'This is the row of my first cell. 
    x = 4 
 
    Do While objSheet.Cells(x, 2).Value <> ""
    strTemp = strTemp & objExcel.Cells(x, 2).Value & Space(10 - Len(objExcel.Cells(x, 2).Value)) 
        strTemp = strTemp & objExcel.Cells(x, 3).Value & Space(50 - Len(objExcel.Cells(x, 3).Value)) 
    strTemp = strTemp & objExcel.Cells(x, 4).Value & Space(50 - Len(objExcel.Cells(x, 4).Value)) 
    strTemp = strTemp & objExcel.Cells(x, 5).Value
    strTemp = strTemp & vbcrlf 'THIS BIT DOESN'T - THE LINE BREAK IS IGNORED
        x = x + 1 
    loop 


    MsgBox ("Hello" & Chr(10) & strTemp) 'THIS DISPLAYS THE RECORDS CORRECTLY SPACED BY A CARRIAGE RETURN


   'This will prevent Excel from prompting us to save the workbook. 
    objExcel.ActiveWorkbook.Saved = True 


   'Close the workbook and exit the application. 
    objWB.Close 
    objExcel.Quit 
    set objWB = Nothing 
    set objExcel = Nothing 


    GetData = strTemp 


End Function

'Main function.


Dim strBody 
Dim MyHour
Dim SalutationString


MyHour = Hour(now)
Select Case MyHour
  Case 0,1,2,3,4,5,6,7,8,9,10,11
    SalutationString = "Good Morning,"
  Case 12,13,14,15,16,17
    SalutationString = "Good Afternoon,"
  Case else
    SalutationString = "Good Evening,"
End Select
'MsgBox(SalutationString)


Set objMessage = CreateObject("CDO.Message") 
objMessage.Subject = "Inventory report for " & Date 
objMessage.From = "No.Body@Nowhere.com" 
objMessage.To = "Pete.Rooney@bet365.com" 


StrBody = ""
StrBody = StrBody & "Summary Email"
StrBody = StrBody & "

"
StrBody = StrBody & "" & SalutationString & ""
StrBody = StrBody & ""
StrBody = StrBody & "" & "CatNo" & ""
StrBody = StrBody & "" & " - " & ""
StrBody = StrBody & "" & "Title" & ""
StrBody = StrBody & "" & " - " & ""
StrBody = StrBody & "" & "Year" & ""
StrBody = StrBody & "" & " - " & ""
StrBody = StrBody & "" & "B-Side" & ""
StrBody = StrBody & ""

'Here we call the function GetData to populate the body text. 
strBody = strBody & GetData
objMessage.HTMLBody = strBody 


ObjMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")=2

'SMTP Server
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")="MyServer.co.uk"

'SMTP Port (if 25 doesn't work, try 465)
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25 


'-------------------------------------------------------------------------------------------------------
'If the SMTP server requires authentication, include the next three lines
'-------------------------------------------------------------------------------------------------------
'SMTP Auth (For Windows Auth set this to 2)
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1
'Username
'objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername")="username" 
'Password
'objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword")="password"
'-------------------------------------------------------------------------------------------------------

objMessage.Configuration.Fields.Update
objMessage.Send

There's a bit more than this, but it contains HTML tags which were making my first post unreadable.