' ****************************************************** ' * ' * Name: modWriteXlsFile.vbs ' * ' * Design Phase: ' * Author: John Miner ' * Date: 06/30/2008 ' * Purpose: A module to write xls files. ' * ' ****************************************************** ' ' 3 - Define a module to write a xls file ' ' Declare all variables Option Explicit ' Define constants Const adChar = 129 Const adNumeric = 131 Const adInteger = 3 Const adPersistXML = 1 Const adUseClient = 3 Const adCmdText = 1 ' ' Define the class ' Class clsWriteXlsFile ' -- Pipe Delimited Data -- Private strOneRec Public Property Get OneRec OneRec = strOneRec End Property Public Property Let OneRec(varOneRec) strOneRec = varOneRec End Property ' -- Define the worksheet name -- Private strSheetName Public Property Get SheetName SheetName = strSheetName End Property Public Property Let SheetName(varSheetName) strSheetName = varSheetName End Property ' -- Pipe Delimited Worksheet Definition -- Private strSheetDef Public Property Get SheetDef SheetDef = strSheetDef End Property Public Property Let SheetDef(varSheetDef) strSheetDef = varSheetDef End Property ' -- Data element - Connection -- Dim objCon ' -- Data element - Command -- Dim objCmd ' ' A - initialize the class ' Private Sub Class_Initialize() ' Create the connection object Set objCon = CreateObject("ADODB.Connection") ' Create the command object Set objCmd = CreateObject("ADODB.Command") End Sub ' ' B - destroy the class ' Private Sub Class_Terminate() ' Just incase object not allocated On Error Resume Next ' Clean up cmd obj set objCmd = nothing ' Clean up conn obj objCon.Close set objCon = nothing End Sub ' ' A - Define open method ' Public Sub OpenDataFile(strOpenFile) ' Remove the file? RemoveFile strOpenFile, True ' Make up the connection string Dim strCon strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strOpenFile & ";Extended Properties=" & chr(34) & "Excel 8.0;HDR=YES" & chr(34) ' Open the connection objCon.ConnectionString = strCon objCon.Open ' Text command type objCmd.ActiveConnection = objCon objCmd.CommandType = adCmdText End Sub ' ' B - Define create data worksheet ' Public Sub CreateWorkSheet() ' Define local variables Dim intCnt Dim strSql Dim arySheetDef ' Parse out the table definition arySheetDef = split(strSheetDef, "|") ' Define worksheet name strSql = "" strSql = strSql & "CREATE TABLE " strSql = strSql & strSheetName strSql = strSql & " (" ' Define worksheet columns for intCnt = lbound(arySheetDef) to ubound(arySheetDef) strSql = strSql & arySheetDef(intCnt) if intCnt <> ubound(arySheetDef) then strSql = strSql & ", " end if next ' End definition strSql = strSql & " )" ' Create the sheet objCmd.CommandText = strSql objCmd.Execute End Sub ' ' C - Define push data method ' Public Sub PushData() ' Define local variables Dim intCnt Dim strSql Dim aryOneRec ' Parse out the table definition aryOneRec = split(strOneRec, "|") ' Select worksheet name strSql = "" strSql = strSql & "INSERT INTO " strSql = strSql & strSheetName strSql = strSql & " VALUES (" ' Insert data into worksheet columns for intCnt = lbound(aryOneRec) to ubound(aryOneRec) strSql = strSql & chr(34) & aryOneRec(intCnt) & chr(34) if intCnt <> ubound(aryOneRec) then strSql = strSql & ", " end if next ' End definition strSql = strSql & " )" ' Insert the record objCmd.CommandText = strSql objCmd.Execute End Sub ' ' D - Define close method ' Public Sub CloseDataFile() ' Nothing to do End Sub ' ' E - Define remove the file method ' Public Sub RemoveFile(strFile, intYes) ' Nothing to do If Not intYes Then Exit Sub End if ' Declare file variables Dim objFSO Dim objFile ' Get the file system object Set objFSO = CreateObject("Scripting.FileSystemObject") ' Remove old file if it exists! If objFSO.FileExists(strFile) Then Set objFile = objFSO.GetFile(strFile) objFile.Delete End If ' Clean up objects Set objFile = Nothing Set objFSO = Nothing End Sub End Class