Automating QTP Test Automation Home Automation Articles Downloads QTP Gotchas Links Books Contact About Site Map
Automate - SQL - Oracle 10g V1.1If you find an error, or have a suggestion for improvement, Email me and I'll fix it. This code generates a function library containing SQL code for manipulating the Oracle 10g database you point it at. This code has been designed for Oracle 10g, it might work with other versions of Oracle, but I haven't tried it. To function correctly, this generator must be supplied with:
The Server name For SAFETY, the generated code has all the SQL Executes commented OUT. YOU MUST review the code before turning the Executes back on.
While this generator only performs READS on a database... The code that is PRODUCED BY this generator CAN DAMAGE YOUR DATA if called incorrectly. DO NOT use this code on a LIVE database. You use this code ENTIRELY at your own risk (see the terms of use). To use, just save this code into a .qfl file, add it to your project and then 'Call GenSql_SqlSvr' to run it. It will ask you various questions and then generate a new .qfl function library file containing the SQL code. Download it Here (right-click and then save target as). (NOTE - you can just cut & paste from below, but the formatting will have multiple spaces instead of tabs).
'=========================================================================
Option Explicit 'V1.0 - First Version 'V1.1 - Date handling added 'NOTE - For safety, the SQL Executes in the generated code are commented out 'Please carefully review the generated code before turning the Executes on 'RELEASE NOTE V1.1 'Now uses Microsoft Oracle driver 'Now handles Dates correctly 'No longer asks for a server name Sub GenSql_Oracle Dim sIni, sApp, sSvr, sDbf, sUsr, sPwd, sCon, oCon, sPath, iTableCount, aTables(99,1), aFields(99,99,3) sIni = "c:\Intellipro.ini" 'Hide... Call zGen_PopupMsg("I'm going to hide while I'm doing this...", 2, 64) Call zQTP_MinimizeWindow 'Get a name for the application sApp = GetApp(sIni) 'Get Database sDbf = GetDbf(sIni,sApp) 'Get User sUsr = GetUsr(sIni,sApp) 'Get Password sPwd = GetPwd(sIni,sApp) 'Get Output Filename sPath = GetPath(sIni,sApp) 'Assemble connection string and try to connect sCon = GetCon(sUsr,sPwd) 'Get the data from the database Call ProcessDatabase(sCon,sDbf,iTableCount,aTables,aFields) 'Generate the output Call GenOutput(sApp,sDbf,sCon,sPath,iTableCount,aTables,aFields,False) End Sub '======================================== Sub GenSql_OracleIni(sApp) 'Usage: 'Call GenSql_OracleIni(sAppName) Dim sSvr, sDbf, sUsr, sPwd, sPath, sCon, iTableCount, aTables(99,1), aFields(99,99,3) 'Hide... Call zGen_PopupMsg("I'm going to hide while I'm doing this...", 2, 64) Call zQTP_MinimizeWindow sDbf = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Dbf", "HR") sUsr = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Usr", "SYSTEM") sPwd = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Pwd", "password") sPath = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Path", "C:\Program Files\HP\QuickTest Professional\Tests\") sCon = GetCon(sUsr,sPwd) Call ProcessDatabase(sCon,sDbf,iTableCount,aTables,aFields) Call GenOutput(sApp,sDbf,sCon,sPath,iTableCount,aTables,aFields,True) End Sub '======================================== Private Function GetApp(sIniFile) GetApp = GetIniCombo(sIniFile, "Enter App Name (3 - 4 characters are best)", "Apps", "App") End Function '======================================== Private Function GetDbf(sIni,sApp) Dim sDbf sDbf = zGen_GetIni(sIni, "App_" & sApp, "Dbf", "HR") sDbf = Inputbox ("Enter the name of your Database:", "User Input Required", sDbf) If sDbf = "" Then Call ExitTest() End If Call zGen_SetIni(sIni, "App_" & sApp, "Dbf", sDbf) GetDbf = sDbf End Function '======================================== Private Function GetUsr(sIni,sApp) Dim sUsr sUsr = zGen_GetIni(sIni, "App_" & sApp, "Usr", "SYSTEM") sUsr = Inputbox ("Enter a Username for that database:", "User Input Required", sUsr) If sUsr = "" Then Call ExitTest() End If Call zGen_SetIni(sIni, "App_" & sApp, "Usr", sUsr) GetUsr = sUsr End Function '======================================== Private Function GetPwd(sIni,sApp) Dim sPwd sPwd = zGen_GetIni(sIni, "App_" & sApp, "Pwd", "password") sPwd = Inputbox ("Enter a Password for that user:", "User Input Required", sPwd) If sPwd = "" Then Call ExitTest() End If Call zGen_SetIni(sIni, "App_" & sApp, "Pwd", sPwd) GetPwd = sPwd End Function '======================================== Private Function GetCon(sUsr,sPwd) Dim sCon, oCon, iErr, sErr, sMsg, sDriver Call zGen_PopupMsg("Trying Database Connection...", 2, 64) sCon = "Driver={Microsoft ODBC for Oracle};Uid=" & sUsr & ";Pwd=" & sPwd & ";" Set oCon = CreateObject("adodb.connection") 'Try to connect On Error Resume Next oCon.Open sCon iErr = Err.Number sErr = Err.Description On Error GoTo 0 'Handle Errors If iErr <> 0 Then If iErr = -2147467259 Then sMsg = "Oracle Server does not exist, access denied or service not running" ElseIf iErr = -2147217843 Then sMsg = "Login Failed for User - Invalid User name or Password" Else sMsg = cStr(iErr) & " - " & sErr End If Call zGen_PopupMsg(sMsg, 5, 48) Call zGen_PopupMsg("Database Connection Failed - Aborting", 1, 16) Call ExitTest() End If oCon.Close Set oCon = Nothing Call zGen_PopupMsg("Database Connected OK", 2, 64) GetCon = sCon End Function '======================================== Private Function GetPath(sIni,sApp) Dim sPath sPath = "C:\Program Files\HP\QuickTest Professional\Tests\" sPath = zGen_GetIni(sIni, "App_" & sApp, "Path", sPath) sPath = Inputbox ("Please confirm the folder for the generated output files:", "User Input Required", sPath) If sPath = "" Then Call ExitTest() End If If Right(sPath,1) <> "\" Then sPath = sPath & "\" End If 'Check the path exists If Not zFile_FolderExists(sPath) Then Call zGen_PopupMsg("Path NOT Found:" & sPath, 5, 48) Call zGen_PopupMsg("Invalid Path for files - Aborting", 1, 16) Call ExitTest() End If Call zGen_SetIni(sIni, "App_" & sApp, "Path", sPath) GetPath = sPath End Function '======================================== Private Function ProcessDatabase(sCon,sDbf,iTableCount,aTables,aFields) Dim oCon Set oCon = CreateObject("adodb.connection") oCon.Open sCon iTableCount = GetDatabaseTables(oCon,sDbf,aTables) Call GetDatabaseFields(oCon,sDbf,iTableCount,aTables,aFields) Call GetDatabasePrimaryKeys(oCon,sDbf,iTableCount,aTables,aFields) oCon.Close Set oCon = Nothing Call ProcessArray(iTableCount,aTables,aFields) End Function '======================================== Private Function GetDatabaseTables(oCon,sDbf,aTables) Dim oRec, sSql, iTableCount, sTable Call zGen_PopupMsg("Getting database tables...", 2, 64) iTableCount = 0 Set oRec = CreateObject("ADODB.Recordset") sSql = "SELECT table_name FROM all_tables WHERE owner = '" & sDbf & "'" oRec.Open sSQL, oCon If NOT oRec.Eof Then oRec.MoveFirst While NOT oRec.Eof sTable = oRec.Fields("table_name") aTables(iTableCount,0) = sTable iTableCount = iTableCount + 1 oRec.MoveNext Wend End If oRec.Close Set oRec = Nothing If iTableCount = 0 Then Call zGen_PopupMsg("No tables found - Invalid Database?", 5, 48) Call zGen_PopupMsg("Nothing to Generate - Aborting", 5, 2) Call ExitTest() End If GetDatabaseTables = iTableCount End Function '======================================== Private Sub GetDatabaseFields(oCon,sDbf,iTableCount,aTables,aFields) Call zGen_PopupMsg("Getting database fields...", 2, 64) Dim iTableIndex For iTableIndex = 0 to iTableCount-1 aTables(iTableIndex,1) = GetTableFields(oCon,sDbf,iTableIndex,aTables,aFields) Next End Sub '======================================== Private Function GetTableFields(oCon,sDbf,iTableIndex,aTables,aFields) Dim sTable, oRec, sSql, iFieldCount, sFieldName, sFieldType sTable = aTables(iTableIndex,0) iFieldCount = 0 Set oRec = CreateObject("ADODB.Recordset") sSql = "select * from all_tab_columns WHERE table_name = '" & sTable & "' AND owner = '" & sDbf & "'" oRec.Open sSQL, oCon If NOT oRec.Eof Then oRec.MoveFirst While NOT oRec.Eof aFields(iTableIndex,iFieldCount,0) = oRec.Fields("COLUMN_NAME") aFields(iTableIndex,iFieldCount,1) = oRec.Fields("DATA_TYPE") aFields(iTableIndex,iFieldCount,2) = "X" iFieldCount = iFieldCount + 1 oRec.MoveNext Wend End If GetTableFields = iFieldCount oRec.Close Set oRec = Nothing End Function '======================================== Private Sub GetDatabasePrimaryKeys(oCon,sDbf,iTableCount,aTables,aFields) Dim iTableIndex Call zGen_PopupMsg("Getting database primary keys...", 2, 64) For iTableIndex = 0 to iTableCount-1 Call GetDatabasePrimaryKey(oCon,sDbf,iTableIndex,aTables,aFields) Next End Sub '======================================== Private Sub GetDatabasePrimaryKey(oCon,sDbf,iTableIndex,aTables,aFields) Dim sTable, oRec, sSql, iFieldIndex, sFieldName, sFieldStat sTable = aTables(iTableIndex,0) sSql = "SELECT cols.column_name, cols.position, cons.status " sSql = sSql & "FROM all_constraints cons, all_cons_columns cols " sSql = sSql & "WHERE cols.table_name = '" & sTable & "' " sSql = sSql & "AND cons.constraint_type = 'P' " sSql = sSql & "AND cons.constraint_name = cols.constraint_name " sSql = sSql & "AND cons.owner = '" & sDbf & "' " sSql = sSql & "ORDER BY cols.table_name, cols.position" Set oRec = CreateObject("ADODB.Recordset") oRec.Open sSQL, oCon If NOT oRec.Eof Then oRec.MoveFirst While Not oRec.Eof sFieldName = oRec.Fields("column_name") sFieldStat = oRec.Fields("status") If sFieldStat = "ENABLED" Then iFieldIndex = GetFieldIndex(iTableIndex,sFieldName,aTables,aFields) aFields(iTableIndex,iFieldIndex,2) = "P" End If oRec.MoveNext Wend End If oRec.Close Set oRec = Nothing End Sub '======================================== Private Function GetFieldIndex(iTableIndex,sField,aTables,aFields) 'Determine the index of the field required Dim iFieldCount, iFieldIndex, sFieldName iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) If sFieldName = sField Then GetFieldIndex = iFieldIndex Exit For End If Next End Function '======================================== Private Sub ProcessArray(iTableCount,aTables,aFields) Dim iTableIndex, iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus For iTableIndex = 0 to iTableCount-1 iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) Select Case sFieldType Case "CHAR", "VARCHAR2" aFields(iTableIndex,iFieldIndex,3) = "s" 'Strings Case "NUMBER" aFields(iTableIndex,iFieldIndex,3) = "i" 'Numerics Case "DATE" aFields(iTableIndex,iFieldIndex,3) = "d" 'Dates Case Else aFields(iTableIndex,iFieldIndex,3) = "x" 'Not Handled End Select Next Next End Sub '======================================== Private Function GetFunctionSafeTableName(sInput) 'This function converts a table name to one that is safe to use in a function name 'Database tables can contain spaces! (I don't recommend it) Dim sOutput sOutput = Replace(sInput, " ", "_") 'Oracle tables are all upper case - yuk! sOutput = Left(sOutput,1) & Lcase(Mid(sOutput,2)) 'Add other adjustments here... GetFunctionSafeTableName = sOutput End Function '======================================== Private Function GetNiceVarName(sInput) 'convert: 'XXXXXX -> Xxxxxx 'XXXXX_XXXXX -> XxxxxXxxxx Dim sOutput, iPosn, sLeft, sRight sOutput = sInput 'XXXXXX -> Xxxxxx 'XXXXX_XXXXX -> Xxxxx_xxxxx sOutput = Left(sOutput,1) & Lcase(Mid(sOutput,2)) 'Xxxxx_xxxxx -> XxxxxXxxxx iPosn = InStr(sOutput,"_") If iPosn > 0 Then sLeft = Left(sOutput,iPosn-1) sRight = Mid(sOutput,iPosn+1) sRight = Ucase(Left(sRight,1)) & Lcase(Mid(sRight,2)) sOutput = sLeft & sRight End If GetNiceVarName = sOutput End Function '======================================== Private Function GetLongestFieldName(iTableIndex,aTables, aFields) Dim iLongest, iFieldCount, iFieldIndex, sFieldName, iFieldNameLength iLongest = 0 iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 To iFieldCount - 1 sFieldName = aFields(iTableIndex,iFieldIndex,0) iFieldNameLength = Len(sFieldName) If iFieldNameLength > iLongest Then iLongest = iFieldNameLength End If Next GetLongestFieldName = iLongest End Function '======================================== Private Function GetKeyFieldIndex(iTableIndex,aTables, aFields) 'Looks for a unique identifier for deletes, gets, etc. 'At the moment, this looks for the primary key on the table 'If that fails, it looks for a name suffix of ID 'It does NOT yet work properly for compound keys and only gets the first field Dim iKeyFieldIndex, iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus 'Dummy value for when we give up iKeyFieldIndex = -1 iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 To iFieldCount - 1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) If sFieldStatus = "P" Then iKeyFieldIndex = iFieldIndex Exit For End If Next 'If it failed try another strategy - fieldnames ending in 'ID' are a good candidate If iKeyFieldIndex = -1 Then For iFieldIndex = 0 To iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) If Right(sFieldName,2) = "ID" Then iKeyFieldIndex = iFieldIndex Exit For End If Next End If GetKeyFieldIndex = iKeyFieldIndex End Function '======================================== Private Sub zGen_PopupMsg(sMsg, iDelay, iStyle) Dim oShell If iDelay = 0 Then Msgbox sMsg Else Set oShell = CreateObject("Wscript.Shell") oShell.Popup sMsg, iDelay, "", iStyle Set oShell = Nothing End If End Sub '======================================== Private Sub zQTP_MinimizeWindow Dim oApp Set oApp = GetObject("","QuickTest.Application") oApp.WindowState = "Minimized" Set oApp = Nothing End Sub '======================================== Private Function zGen_GetIni(sIniFile, sSection, sKey, sDefault) Dim iRet, sReturnString Extern.Declare micLong, "GetPrivateProfileString", "kernel32.dll", "GetPrivateProfileStringA", micString, micString, micString, micString + micByRef, micDWord, micString iRet = Extern.GetPrivateProfileString(sSection, sKey, sDefault, sReturnString, 256, sIniFile) If iRet > 0 Then zGen_GetIni = sReturnString Else zGen_GetIni = sDefault End If End Function '======================================== Private Sub zGen_SetIni(sIniFile, sSection, sKey, sValue) Dim iRet Extern.Declare micLong, "WritePrivateProfileString", "kernel32.dll", "WritePrivateProfileStringA", micString, micString, micString, micString iRet = Extern.WritePrivateProfileString(sSection, sKey, sValue, sIniFile) End Sub '======================================== Private Function GetIniCombo(sIniFile, sTitle, sSection, sKey) Dim iCount, sValue, sReply, oFrm, oBtn, oCbo, x, y, posn, iLoop, asList(100), iReply Dim sGenKey, sGenData 'Get the last general reference if any sValue = zGen_GetIni(sIniFile, sSection, sKey, sKey) 'Get the count iCount = cInt(zGen_GetIni(sIniFile, sSection, sKey & "Count" , "0")) If iCount = 0 Then 'A new case, use an input box sReply = Inputbox (sTitle, "User Input Required", sValue) If sReply = "" Then 'User Abort... Call ExitTest() End If 'Start populating the list Call zGen_SetIni(sIniFile, sSection, sKey & "Count", "01") Call zGen_SetIni(sIniFile, sSection, sKey & "01", sReply) Else 'Set up a screen with a combobox Set oFrm = DotNetFactory.CreateInstance("System.Windows.Forms.Form", "System.Windows.Forms") Set oBtn = DotNetFactory.CreateInstance("System.Windows.Forms.Button", "System.Windows.Forms") Set oCbo = DotNetFactory.CreateInstance("System.Windows.Forms.ComboBox", "System.Windows.Forms") x = 10 y = 10 Set posn = DotNetFactory.CreateInstance("System.Drawing.Point", "System.Drawing", x, y) 'Populate the array and combo For iLoop = 1 to iCount sGenKey = sKey & Right("00" & cStr(iLoop),2) sGenData = zGen_GetIni(sIniFile, sSection, sGenKey , "Gen") asList(iLoop) = sGenData oCbo.Items.Add sGenData If sGenData = sValue Then 'Set the default value to the value the user chose last time oCbo.Text = sGenData End If Next oCbo.Location = posn posn.X = 60 posn.Y = 30 oBtn.Text = "OK" posn.Y = CInt(oCbo.Height) + 20 oBtn.Location = posn oFrm.AcceptButton = oBtn oFrm.CancelButton = oBtn oFrm.Controls.Add(oBtn) oFrm.Controls.Add(oCbo) oFrm.Width = 500 oFrm.Text = sTitle oFrm.Topmost = True oFrm.ShowDialog sReply = oCbo.Text If sReply = "" Then 'User Abort... Call ExitTest() End If 'Has the user chosen from the list or entered a new value? 'Scan the array iReply = 0 For iLoop = 1 to iCount If sReply = asList(iLoop) Then iReply = iLoop Exit For End If Next If iReply = 0 Then 'User has entered a new value, add it to the list Call zGen_SetIni(sIniFile, sSection, sKey & "Count", cStr(iCount+1)) Call zGen_SetIni(sIniFile, sSection, sKey & Right("00" & cStr(iCount+1),2),sReply) 'Else 'User has chosen an existing value - no action required End If End If 'Save the value for future defaults Call zGen_SetIni(sIniFile, sSection, sKey, sReply) 'Return the value GetIniCombo = sReply End Function '======================================== Private Function zFile_FolderExists(sFolder) Dim oFso Set oFso = CreateObject("Scripting.FileSystemObject") If oFso.FolderExists(sFolder) Then zFile_FolderExists = True Else zFile_FolderExists = False End If Set oFso = Nothing End Function '======================================== Private Sub GenOutput(sApp,sDbf,sCon,sPath,iTableCount,aTables,aFields,bOverwrite) Call zGen_PopupMsg("Generating Output...", 2, 64) 'Process each table Dim iTableIndex For iTableIndex = 0 to iTableCount-1 Call GenOutputTable(sApp,sDbf,sCon,sPath,iTableIndex,aTables,aFields,bOverwrite) Next End Sub '======================================== Private Sub GenOutputTable(sApp,sDbf,sCon,sPath,iTableIndex,aTables,aFields,bOverwrite) Dim sFileName, sTableName, sTableNameF, iFieldCount, oFso, oFile Const ForWriting = 2, TristateTrue = -1 Dim sParam, iLineCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, sQ, bQ Dim sClassName, iRet, bProcessFile sTableName = aTables(iTableIndex,0) sTableNameF = GetFunctionSafeTableName(sTableName) iFieldCount = aTables(iTableIndex,1) sClassName = "App_" & sApp & "_Sql_" & sTableNameF sFileName = sPath & "App_" & sApp & "_Sql_" & sTableNameF & ".qfl" If bOverwrite Then bProcessFile = True Else bProcessFile = False 'Detect and warn if file exists already If zFile_Exists(sFileName) Then iRet = MsgBox(sFileName,vbExclamation+vbYesNo+vbDefaultButton2,"Warning - File Exists - Overwrite?") If iRet= vbYes Then bProcessFile = True End If Else bProcessFile = True End If End If If bProcessFile Then 'Open the file (in Unicode) Set oFso = CreateObject("Scripting.FileSystemObject") Set oFile = oFso.OpenTextFile(sFileName, ForWriting, True, TristateTrue) 'Write header oFile.WriteLine("Option Explicit") oFile.WriteLine("") oFile.WriteLine("'Database SQL Functions") oFile.WriteLine("") oFile.WriteLine("'For App : " & sApp) oFile.WriteLine("'For Database : " & sDbf) oFile.WriteLine("'For Table : " & sTableName) oFile.WriteLine("") oFile.WriteLine("'Intellipro Script SQL Generator for Oracle") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"/")) oFile.WriteLine("") oFile.WriteLine("Class " & sClassName) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"\")) oFile.WriteLine("") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim oCon") oFile.WriteLine("") Call GenDim(oFile,iTableIndex,aTables,aFields) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") Call GenInit(oFile, sCon) Call GenTerm(oFile) Call GenAdd(oFile,iTableIndex,aTables,aFields) Call GenGet(oFile,iTableIndex,aTables,aFields) Call GenUpd(oFile,iTableIndex,aTables,aFields) Call GenDel(oFile,iTableIndex,aTables,aFields) Call GenExi(oFile,iTableIndex,aTables,aFields) Call GenLets(oFile,iTableIndex,aTables,aFields) Call GenGets(oFile,iTableIndex,aTables,aFields) Call GenFunc(oFile) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"/")) oFile.WriteLine("") oFile.WriteLine("End Class '" & sClassName) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"\")) oFile.WriteLine("") 'Footer oFile.WriteLine("") oFile.WriteLine("'" & String(40,"#")) oFile.Close End If End Sub '======================================== Private Sub GenInit(oFile, sCon) oFile.WriteLine("Private Sub Class_Initialize") 'oFile.WriteLine(vbTab & "'Print " & Chr(34) & "<<< Initialize >>>" & Chr(34)) oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'This code gets executed automatically when the class object is created") 'oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & Chr(34) & "ADODB.Connection" & Chr(34) & ")") oFile.WriteLine("") oFile.WriteLine(vbTab & "oCon.Open " & Chr(34) & sCon & Chr(34)) oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & Chr(34) & ">>> Initialize <<<" & Chr(34)) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenTerm(oFile) oFile.WriteLine("Private Sub Class_Terminate") 'oFile.WriteLine(vbTab & "'Print " & Chr(34) & "<<< Terminate >>>" & Chr(34)) oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'This code gets executed automatically when the class object is destroyed (set to nothing)") 'oFile.WriteLine("") oFile.WriteLine(vbTab & "oCon.Close") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oCon = Nothing") oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & Chr(34) & ">>> Terminate <<<" & Chr(34)) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenDim(oFile,iTableIndex,aTables,aFields) Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, iPad, sFieldTypeX iFieldCount = aTables(iTableIndex,1) iPad = GetLongestFieldName(iTableIndex,aTables,aFields) For iFieldIndex = 0 to iFieldCount-1 sFieldName = GetNiceVarName(aFields(iTableIndex,iFieldIndex,0)) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) oFile.WriteLine(vbTab & "Dim " & Left(sFieldClass & "m" & sFieldName & Space(iPad+5),iPad+5) & "'" & sFieldType) Next End Sub '======================================== Private Sub GenLets(oFile,iTableIndex,aTables,aFields) Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) If sFieldClass = "s" Then oFile.WriteLine("Public Property Let " & sFieldClass & GetNiceVarName(sFieldName) & "(sValue)") ElseIf sFieldClass = "d" Then oFile.WriteLine("Public Property Let " & sFieldClass & GetNiceVarName(sFieldName) & "(dValue)") ElseIf sFieldClass = "i" Then oFile.WriteLine("Public Property Let " & sFieldClass & GetNiceVarName(sFieldName) & "(iValue)") Else oFile.WriteLine("Public Property Let " & sFieldClass & GetNiceVarName(sFieldName) & "(xValue)") End If oFile.WriteLine("") If sFieldClass = "s" Then oFile.WriteLine(vbTab & sFieldClass & "m" & GetNiceVarName(sFieldName) & " = zSql_ProtectField(sValue)") ElseIf sFieldClass = "d" Then oFile.WriteLine(vbTab & sFieldClass & "m" & GetNiceVarName(sFieldName) & " = dValue") ElseIf sFieldClass = "i" Then oFile.WriteLine(vbTab & sFieldClass & "m" & GetNiceVarName(sFieldName) & " = iValue") Else oFile.WriteLine(vbTab & sFieldClass & "m" & GetNiceVarName(sFieldName) & " = zSql_ProtectField(xValue)") End If oFile.WriteLine("") oFile.WriteLine("End Property") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"~")) oFile.WriteLine("") Next oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenGets(oFile,iTableIndex,aTables,aFields) Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) 'oFile.WriteLine("Public Default Property Get " & sFieldName) oFile.WriteLine("Public Property Get " & sFieldClass & GetNiceVarName(sFieldName)) oFile.WriteLine("") oFile.WriteLine(vbTab & sFieldClass & GetNiceVarName(sFieldName) & " = " & sFieldClass & "m" & GetNiceVarName(sFieldName)) oFile.WriteLine("") oFile.WriteLine("End Property") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"~")) oFile.WriteLine("") Next oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenExi(oFile,iTableIndex,aTables,aFields) Dim sTableName, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sQ sQ = Chr(34) sTableName = aTables(iTableIndex,0) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Function [Exists](" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") 'oFile.WriteLine(vbTab & "'Print " & Chr(34) & "<<< Exists >>>" & Chr(34)) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Checks if an entry exists in the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim oRec, sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec=CreateObject(" & Chr(34) & "ADODB.Recordset" & Chr(34) & ")") oFile.WriteLine("") If sKeyFieldClass = "s" Then oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = '" & sQ & " & " & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & " & " & sQ & "'" & sQ) Else oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") End If oFile.WriteLine("") oFile.WriteLine(vbTab & "Print sSql") oFile.WriteLine(vbTab & "Msgbox sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "oRec.Open sSQL, oCon") oFile.WriteLine("") oFile.WriteLine(vbTab & "If oRec.Eof Then") oFile.WriteLine(vbTab & vbTab & "[Exists] = False") oFile.WriteLine(vbTab & "Else") oFile.WriteLine(vbTab & vbTab & "[Exists] = True") oFile.WriteLine(vbTab & "End If") oFile.WriteLine("") oFile.WriteLine(vbTab & "oRec.Close") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec=Nothing") oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & Chr(34) & ">>> Exists <<<" & Chr(34)) oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenDel(oFile,iTableIndex,aTables,aFields) Dim sTableName, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sQ sQ = Chr(34) sTableName = aTables(iTableIndex,0) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Sub [Delete](" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") 'oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Delete >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Deletes an entry from the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sSql") oFile.WriteLine("") If sKeyFieldClass = "s" Then oFile.WriteLine(vbTab & "sSql = " & sQ & "DELETE FROM " & sTableName & " WHERE " & sKeyFieldName & " = '" & sQ & " & " & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & " & " & sQ & "'" & sQ) Else oFile.WriteLine(vbTab & "sSql = " & sQ & "DELETE FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") End If oFile.WriteLine("") oFile.WriteLine(vbTab & "Print sSql") oFile.WriteLine(vbTab & "Msgbox sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'########## WARNING ##########") oFile.WriteLine("") oFile.WriteLine(vbTab & "'This code can damage your data") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Review it carefully BEFORE turning the Execute ON") oFile.WriteLine("") oFile.WriteLine(vbTab & "MsgBox " & sQ & "SQL Execute is currently turned off, remove comment to activate" & sQ & ", vbExclamation, " & sQ & "Function: Delete " & sTableName & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'oCon.Execute sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'#############################") oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Delete <<<" & sQ) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenAdd(oFile,iTableIndex,aTables,aFields) Dim sTableName, sQ, iLineCount, iFieldIndex, iFieldCount, bQ Dim sFieldName, sFieldType, sFieldStatus, sFieldClass sQ = Chr(34) sTableName = aTables(iTableIndex,0) iFieldCount = aTables(iTableIndex,1) oFile.WriteLine("Public Sub [Add]") 'oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Add >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Adds an entry to the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sSql, oRec") oFile.WriteLine("") 'Assemble the SQL... oFile.WriteLine(vbTab & "sSql = " & sQ & "INSERT INTO " & sTableName & sQ) oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "(" & sQ) oFile.WriteLine("") 'Database Fields iLineCount = 0 For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) iLineCount = iLineCount + 1 If iLineCount = 1 Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & sFieldName & sQ) Else oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "," & sQ & " & " & sQ & sFieldName & sQ) End If Next oFile.WriteLine("") oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & ") VALUES (" & sQ) oFile.WriteLine("") 'Values bQ = False iLineCount = 0 For iFieldIndex = 0 to iFieldCount-1 sFieldName = "m" & GetNiceVarName(aFields(iTableIndex,iFieldIndex,0)) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) iLineCount = iLineCount + 1 If iLineCount = 1 Then If sFieldClass = "s" Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'" & sQ & " & " & sFieldClass & sFieldName) bQ = True ElseIf sFieldClass = "d" Then oFile.WriteLine(vbTab & "sSql = sSql & cDat(" & sFieldClass & sFieldName & ")") bQ = False Else oFile.WriteLine(vbTab & "sSql = sSql & cStr(" & sFieldClass & sFieldName & ")") bQ = False End If Else If sFieldClass = "s" Then If bQ Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "','" & sQ & " & " & sFieldClass & sFieldName) Else oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & ",'" & sQ & " & " & sFieldClass & sFieldName) End If bQ = True ElseIf sFieldClass = "d" Then If bQ Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'," & sQ & " & cDat(" & sFieldClass & sFieldName & ")") Else oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "," & sQ & " & cDat(" & sFieldClass & sFieldName & ")") End If bQ = False Else If bQ Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'," & sQ & " & cStr(" & sFieldClass & sFieldName & ")") Else oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "," & sQ & " & cStr(" & sFieldClass & sFieldName & ")") End If bQ = False End If End If Next oFile.WriteLine("") If bQ Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "')" & sQ) Else oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & ")" & sQ) End If oFile.WriteLine("") oFile.WriteLine(vbTab & "Print sSql") oFile.WriteLine(vbTab & "Msgbox sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'########## WARNING ##########") oFile.WriteLine("") oFile.WriteLine(vbTab & "'This code can damage your data") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Review it carefully BEFORE turning the Execute ON") oFile.WriteLine("") oFile.WriteLine(vbTab & "MsgBox " & sQ & "SQL Execute is currently turned off, remove comment to activate" & sQ & ", vbExclamation, " & sQ & "Function: Add " & sTableName & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'oCon.Execute sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'#############################") oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Add <<<" & sQ) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenGet(oFile,iTableIndex,aTables,aFields) Dim sTableName, sQ, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, iFieldCount, iFieldIndex Dim sFieldName, sFieldType, sFieldStatus, sFieldClass, iPad, sLine sQ = Chr(34) sTableName = aTables(iTableIndex,0) iFieldCount = aTables(iTableIndex,1) iPad = GetLongestFieldName(iTableIndex,aTables,aFields) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "Xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Function [Get](" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") 'oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Get >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Get an entry from the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim oRec, sSql") oFile.WriteLine("") If sKeyFieldClass = "s" Then oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = '" & sQ & " & " & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & " & " & sQ & "'" & sQ) Else oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") End If oFile.WriteLine("") oFile.WriteLine(vbTab & "Print sSql") oFile.WriteLine(vbTab & "Msgbox sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec = CreateObject(" & sQ & "ADODB.Recordset" & sQ & ")") oFile.WriteLine("") oFile.WriteLine(vbTab & "oRec.Open sSQL, oCon") oFile.WriteLine("") oFile.WriteLine(vbTab & "If oRec.Eof Then") oFile.WriteLine(vbTab & vbTab & "[Get] = False") oFile.WriteLine("") oFile.WriteLine(vbTab & "Else") oFile.WriteLine(vbTab & vbTab & "[Get] = True") oFile.WriteLine("") oFile.WriteLine(vbTab & vbTab & "oRec.MoveFirst") oFile.WriteLine("") 'Database Fields For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) sLine = vbTab & vbTab & Left(sFieldClass & "m" & GetNiceVarName(sFieldName) & Space(iPad+2),iPad+2) & " = zSql_ProtectNull(" & Chr(34) & sFieldClass & Chr(34) & ",oRec.Fields(" & sQ & sFieldName & sQ & "))" oFile.WriteLine(sLine) Next oFile.WriteLine("") oFile.WriteLine(vbTab & "End If") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec = Nothing") oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Get <<<" & sQ) oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Sub GenUpd(oFile,iTableIndex,aTables,aFields) Dim sTableName, sQ, iFieldCount, iPad, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass Dim iLineCount, bQ, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, sLine sQ = Chr(34) sTableName = aTables(iTableIndex,0) iFieldCount = aTables(iTableIndex,1) iPad = GetLongestFieldName(iTableIndex,aTables,aFields) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "Xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Sub [Update](" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") 'oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Update >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Update an entry in the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sSql") oFile.WriteLine("") 'Create the SQL for the Update oFile.WriteLine(vbTab & "sSql = " & sQ & "UPDATE " & sTableName & sQ) oFile.WriteLine("") oFile.WriteLine( vbTab & "sSql = sSql & " & sQ & " SET " & sQ) oFile.WriteLine("") 'Database Fields iLineCount = 0 bQ = False For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) iLineCount = iLineCount + 1 If iLineCount = 1 Then If sFieldClass = "s" Then sLine = vbTab & "sSql = sSql & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = '" & sQ & " & " & sFieldClass & "m" & GetNiceVarName(sFieldName) bQ = True ElseIf sFieldClass = "d" Then sLine = vbTab & "sSql = sSql & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = " & sQ & " & cDat(" & sFieldClass & "m" & GetNiceVarName(sFieldName) & ")" bQ = False Else sLine = vbTab & "sSql = sSql & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = " & sQ & " & cStr(" & sFieldClass & "m" & GetNiceVarName(sFieldName) & ")" bQ = False End If Else If sFieldClass = "s" Then If bQ Then sLine = vbTab & "sSql = sSql & " & sQ & "'," & sQ & " & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = '" & sQ & " & " & sFieldClass & "m" & GetNiceVarName(sFieldName) Else sLine = vbTab & "sSql = sSql & " & sQ & "," & sQ & " & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = '" & sQ & " & " & sFieldClass & "m" & GetNiceVarName(sFieldName) End If bQ = True ElseIf sFieldClass = "d" Then If bQ Then sLine = vbTab & "sSql = sSql & " & sQ & "'," & sQ & " & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = " & sQ & " & cDat(" & sFieldClass & "m" & GetNiceVarName(sFieldName) & ")" Else sLine = vbTab & "sSql = sSql & " & sQ & "," & sQ & " & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = " & sQ & " & cDat(" & sFieldClass & "m" & GetNiceVarName(sFieldName) & ")" End If bQ = False Else If bQ Then sLine = vbTab & "sSql = sSql & " & sQ & "'," & sQ & " & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = " & sQ & " & cStr(" & sFieldClass & "m" & GetNiceVarName(sFieldName) & ")" Else sLine = vbTab & "sSql = sSql & " & sQ & "," & sQ & " & " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1) sLine = sLine & " & " & sQ & " = " & sQ & " & cStr(" & sFieldClass & "m" & GetNiceVarName(sFieldName) & ")" End If bQ = False End If End If oFile.WriteLine(sLine) Next oFile.WriteLine("") If sKeyFieldClass = "s" Then If bQ Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'" & sQ & " & " & sQ & "WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = '" & sQ & " & " & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & " & " & sQ & "'" & sQ) Else oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & " WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = '" & sQ & " & " & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & " & " & sQ & "'" & sQ) End If Else If bQ Then oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "' " & sQ & " & " & sQ & "WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = " & sQ & " & cStr(" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") Else oFile.WriteLine(vbTab & "sSql = sSql & " & " " & sQ & "WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = " & sQ & " & cStr(" & sKeyFieldClass & GetNiceVarName(sKeyFieldName) & ")") End If End If oFile.WriteLine("") oFile.WriteLine(vbTab & "Print sSql") oFile.WriteLine(vbTab & "Msgbox sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'########## WARNING ##########") oFile.WriteLine("") oFile.WriteLine(vbTab & "'This code can damage your data") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Review it carefully BEFORE turning the Execute ON") oFile.WriteLine("") oFile.WriteLine(vbTab & "MsgBox " & sQ & "SQL Execute is currently turned off, remove comment to activate" & sQ & ", vbExclamation, " & sQ & "Function: Update " & sTableName & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'oCon.Execute sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'#############################") oFile.WriteLine("") 'oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Update <<<" & sQ) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '=========================================================== Private Sub GenFunc(oFile) oFile.WriteLine("Private Function zSql_ProtectField(sInput)") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Remove apostrophes - illegal in sql queries") oFile.WriteLine("") oFile.WriteLine(vbTab & "zSql_ProtectField = Replace(sInput, " & Chr(34) & "'" & Chr(34) & ", " & Chr(34) & "#" & Chr(34) & ")") oFile.WriteLine("") oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine("Private Function zSql_ProtectNull(sType, byVal objField)") oFile.WriteLine("") oFile.WriteLine(vbTab & "If IsNull(objField) Then") oFile.WriteLine(vbTab & vbTab & "Select Case sType") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "s" & Chr(34) & " zSql_ProtectNull = "& Chr(34)& Chr(34)) oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "i" & Chr(34) & " zSql_ProtectNull = 0") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "m" & Chr(34) & " zSql_ProtectNull = 0") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "d" & Chr(34) & " zSql_ProtectNull = "& Chr(34)& Chr(34)) ' 'How to handle null dates? oFile.WriteLine(vbTab & vbTab & vbTab & "Case Else zSql_ProtectNull = "& Chr(34)& Chr(34)) oFile.WriteLine(vbTab & vbTab & "End Select") oFile.WriteLine(vbTab & "Else") oFile.WriteLine(vbTab & vbTab & "Select Case sType") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "s" & Chr(34) & " zSql_ProtectNull = cStr(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "i" & Chr(34) & " zSql_ProtectNull = cLng(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "m" & Chr(34) & " zSql_ProtectNull = cCur(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "d" & Chr(34) & " zSql_ProtectNull = cDate(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case Else zSql_ProtectNull = cStr(objField)") oFile.WriteLine(vbTab & vbTab & "End Select") oFile.WriteLine(vbTab & "End If") oFile.WriteLine("") oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine("Private Function cDat(dInputDate)") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sCurrLocale, sTemp, sDD, sMM, sYYYY") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Save the locale and force it to UK") oFile.WriteLine(vbTab & "sCurrLocale = SetLocale(" & Chr(34) & "en-gb" & Chr(34) & ")") oFile.WriteLine("") oFile.WriteLine(vbTab & "sTemp = cStr(dInputDate)") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Put the locale back the way it was") oFile.WriteLine(vbTab & "SetLocale(sCurrLocale)") oFile.WriteLine("") oFile.WriteLine(vbTab & "sDD = Left(sTemp,2)") oFile.WriteLine(vbTab & "sMM = Mid(sTemp,4,2)") oFile.WriteLine(vbTab & "sYYYY = Mid(sTemp,7,4)") oFile.WriteLine("") oFile.WriteLine(vbTab & "cDat = " & Chr(34) & "to_date('" & Chr(34) & " & sYYYY & sMM & sDD & " & Chr(34) & "','yyyymmdd')" & Chr(34)) oFile.WriteLine("") oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Private Function zFile_Exists(sFileName) Dim oFso Set oFso = CreateObject("Scripting.FileSystemObject") If oFso.FileExists(sFileName) Then zFile_Exists = True Else zFile_Exists = False End If Set oFso = Nothing End Function '========================================================================= |