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
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
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