VBScript to populate CDO email with contents of Excel range

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,275
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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

Rich (BB code):
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.
 
Last edited:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top