Wednesday, October 18, 2006

VBScript: Populating an Excel File from a Database Query using VBScript

While I typically do not recommend using a VBScript to populate an Excel file, I had needed to do so for a script I am passing off responsibility for. This scripts intended purpose is to pull a list of employees who have completed a course and fill out a particular template Excel file we use for mass loading entries into a database. This demonstrates how to instantiate the Excel Application, open a spreadsheet, select a worksheet, and populate from a Visual Basic script. It also demonstrates for to format a date field to the YYYYMMDD format since VBScript lacks the Format for FormatDate functions. It also makes use of External UDL files for the data connection.

'The recordset objects for Our Learning Management System
Dim sumtotal_con
Dim sumtotal_com
Dim sumtotal_rs
Set sumtotal_con = CreateObject("ADODB.Connection")
Set sumtotal_com = CreateObject("ADODB.Command")

Dim ts_con
Dim ts_com
Dim ts_rs
Set ts_con = CreateObject("ADODB.Connection")
Set ts_com = CreateObject("ADODB.Command")

'Create the objects for Excel
Dim e
Dim wb
Dim sheet
Set e = CreateObject("EXCEL.APPLICATION")
e.Workbooks.Open ("C:\auto_rpt\etc\TranscriptTemplate.xls")
Set wb = e.ActiveWorkbook
Set sheet = wb.Sheets("TRANSCRIPTS")

'generic counter and string to format month to 2 digit number
Dim x
dim numericMonth
dim numericDay

WScript.Echo "Run date: " & Now
WScript.Echo "Opening connection to Access Database"
'open the SumTotal Database
sumtotal_con.ConnectionString = "File Name=C:\auto_rpt\etc\SumTotal.udl;"
sumtotal_con.CursorLocation = 3

sumtotal_com.ActiveConnection = sumtotal_con
sumtotal_com.CommandType = 1
sumtotal_com.CommandText = "SELECT GEID, AttemptEndCompleteDate, cOMPLETIONsTATUS, pass, testscore, attemptendcompletedate FROM SOMEARBITRARYDATABASETABLE where SOME = Conditions and ARE = MET"

Set sumtotal_rs = sumtotal_com.Execute
WScript.Echo "Number of records read from database: " & sumtotal_rs.RecordCount

'Open target database to insure values do not already exist
ts_con.ConnectionString = "File Name=C:\auto_rpt\etc\tserve.udl;"
ts_con.CursorLocation = 3

ts.ActiveConnection = ts_con
ts_com.CommandType = 1
ts_com.CommandText = "SELECT 'X' from TARGET_TABLE where cd_crs = 'CE' and geid = ?"
ts_com.Parameters.Append ts_com.CreateParameter("EmpID", adVarChar, adParamInput, 50)

x = 2
While (sumtotal_rs.EOF = False)
ts_com("EmpID") = sumtotal_rs("GEID")
set ts_rs = ts_com.execute

if (ts_rs.RecordCount > 0) then
‘These are arbitrary fields in the spreadsheet. For this demo, you don’t really need
‘to know what they stand for, just that some fields are populating hard coded ‘values, and some are values in the returned query
sheet.Cells(x, 1).Value = "NATL"
sheet.Cells(x, 2).Value = sumtotal_rs("GEID")
sheet.Cells(x, 6).Value = "CE"
sheet.Cells(x, 8).Value = "CESLScript"
sheet.Cells(x, 9).Value = sumtotal_rs("AttemptEndCompleteDate")
sheet.Cells(x, 10).Value = "F = Finished"
sheet.Cells(x, 17).Value = sumtotal_rs("testscore")
end if

x = x + 1

'Get the 2 digit month. VBScript does not include a function for this
if (len(CStr(Month(Now))) < 2) then
numericMonth = "0" & CStr(month(now))
numericMonth = CStr(month(now))
end if

'Get the 2 digit day. VBScript does not include a function for this
if (len(CStr(day(Now))) < 2) then
numericDay = "0" & CStr(day(now))
numericday = CStr(day(now))
end if

Set sheet = Nothing
wb.SaveAs "C:\auto_rpt\ce\Transcript-" & year(now) & numericMonth & numericDay & ".xls"
Set wb = Nothing

Set e = Nothing


Set sumtotal_rs = Nothing
Set sumtotal_com = Nothing
Set sumtotal_con = Nothing

Set ts_rs = Nothing
Set ts_com = Nothing
Set ts_con = Nothing

There are a couple of things to note in the above. The above query to check for the existence of a record before putting it into the template is not the most efficient. The better way to go is to pull a recordset of all employees with my course, and compare against the recordset in local memory. This will alleviate the overhead over querying the database for each record, which the above code does not do. More design is required for that, and for the purposes of this script, this overhead is acceptable. Remember; always develop with a goal in mind and within the confines of your project. If performance were not an acceptable tradeoff for development time, then I would have gone that route. The second assumption is that we do not have write access to the target database, making the mass feed file necessary.


Alex said...

For executes this action I usually use next program-Excel 2007 file repair,why? because software helped me in different serious situation,also it has free status as how as I remember,utiltiy can try Excel repairs manually, by retyping all documents, but it is time consuming, you can spend many days for this purpose, when Excel file has corrupted,tool for Excel repairing is very easy to use, when Excel file corrupted, it has only several buttons and functions for Excel document repair: open file, start its analysis, preview of recovered contents and export of recovered data into a new document in Microsoft Excel format,allows to perform all steps and take a look into recovered contents of this file.

Anonymous said...