Oracle Database Time Model Viewer in Excel 2

1 03 2011

March 1, 2011 (Updated March 2, 2011)

(Back to the Previous Post in the Series) (Forward to the Next Post in the Series)

In the previous blog article in this series, we examined the output generated by one of my programs.  Most of that output was centered on the analysis of the time model statistics in Oracle Database 10.1 and above.  The intention of this blog article series is to try to build a similar tool using nothing more than Microsoft Excel.  I do not know yet if it is possible, but we will definitely try to make it work.  Unfortunately, there are a couple of features missing in Oracle Database 10.1 as well as some of the statistics being named differently from later release versions of Oracle Database, so this project will target Oracle Database 10.2.0.1 and above.  This project will use a Microsoft TreeView control which might not be installed on your computer, however I verified on a Windows 7 32 bit computer with Excel 2010 installed, that if you are able to find the OCX file containing the Treeview and register that file with Windows, it can be used in the Excel development environment for this project.

If you attempted the project in the previous article of this series (that project is the starting point for today’s article), you may have received an odd error message when opening the project (at least I did on Excel 2007).  The message is “Can’t execute code in break mode” – if you received that error message, there is a simple fix – just hit the F5 key on the keyboard to tell Excel to continue executing the code.  The reason why this error message appears is likely related to the ShowModal property of the UserForm.  When that property is set to True (apparently the default), that UserForm has the full attention of Microsoft Excel until it is closed – that of course causes problems when the worksheet opens and the form displays automatically.  There are two methods to work around this issue, the first requires changing the following line in the code:

frmTimeModel.Show 

to this:

frmTimeModel.Show vbModeless 

In my opinion, the above is a little ugly, so let’s instead change the ShowModal property of the UserForm.  View the code in the worksheet (see the directions found in the previous article), double-click frmTimeModel under the Forms heading (below Microsoft Excel Objects that was used in the previous article), click once on the background of the UserForm, and then in the Properties window, change the ShowModal property from True to False (don’t ask me why the constant is spelled differently than the property, someone was just being creative I guess):

Now double-click the UserForm’s background area – that will display the programming code that is related to what we double-clicked (the UserForm in this case).  So far, only the following code should appear in the UserForm’s code – this is what causes the TimerEvent procedure to start executing once a second when the UserForm is first displayed on the screen:

Private Sub UserForm_Initialize()
    TimerEvent
End Sub 

Move the cursor in front of “P” in the word Private and hit the Enter key a couple of times to insert a couple of blank lines.  We will need to copy in a lot of code into that blank area – some of the code will not be used immediately, but we will need it later.  Add the following code above the word Private – these are all of the variables that are needed throughout our UserForm:

Option Explicit

Dim dbDatabase As ADODB.Connection          'The ADO connection to the database

Dim dteLastUpdateDate As Variant            'Last update date for queries
Dim intCheckIterations As Integer           'Number of times to check the instances
Dim intDelayIterations As Integer           'Number of seconds to delay between iterations
Dim sglSessionMinimumPercent As Single      'Minimum percent of the total required for the session to be included in the report detail
Dim dteLastLoopStart As Variant             'Time of the last loop start
Dim intDisplaySessionDetail As Integer      'Indicates whether or not to display the session level detail

Dim intFlag As Integer                      'Loop control variable, allow to jump out of the loop early

Dim intCurrentSessionIndex As Integer       'Session index to the currently selected item in the tree view
Dim intNumCPUs As Integer                   'Number of CPUs
Dim dblIdleTime As Double                   'Current value of idle time from V$OSSTAT
Dim dblBusyTime As Double                   'Current value of busy time from V$OSSTAT
Dim dblUserTime As Double                   'Current value of user time from V$OSSTAT
Dim dblSysTime As Double                    'Current value of system/kernel mode time from V$OSSTAT
Dim dblIdleTimeLast As Double               'Previous value of idle time from V$OSSTAT
Dim dblBusyTimeLast As Double               'Previous value of busy time from V$OSSTAT
Dim dblUserTimeLast As Double               'Previous value of user time from V$OSSTAT
Dim dblSysTimeLast As Double                'Previous value of system/kernel mode time from V$OSSTAT

Dim dblCPUUsedByThisSession As Double       'Current value of 'CPU used by this session' from V$SYSSTAT, in seconds
Dim dblParseTimeCPU As Double               'Current value of 'parse time cpu' from V$SYSSTAT, in seconds
Dim dblRecursiveCPUUsage As Double          'Current value of 'recursive cpu usage' from V$SYSSTAT, in seconds
Dim lngParseCountTotal As Long              'Current value of 'parse count (total)' from V$SYSSTAT
Dim lngParseCountHard As Long               'Current value of 'parse count (hard)' from V$SYSSTAT
Dim lngParseCountFailures As Long           'Current value of 'parse count (failures)' from V$SYSSTAT
Dim lngSessionCacheHits As Long             'Current value of 'session cursor cache hits' from V$SYSSTAT
Dim dblCPUUsedByThisSessionLast As Double   'previous value of 'CPU used by this session' from V$SYSSTAT, in seconds
Dim dblParseTimeCPULast As Double           'Previous value of 'parse time cpu' from V$SYSSTAT, in seconds
Dim dblRecursiveCPUUsageLast As Double      'Previous value of 'recursive cpu usage' from V$SYSSTAT, in seconds
Dim lngParseCountTotalLast As Long          'Previous value of 'parse count (total)' from V$SYSSTAT
Dim lngParseCountHardLast As Long           'Previous value of 'parse count (hard)' from V$SYSSTAT
Dim lngParseCountFailuresLast As Long       'Previous value of 'parse count (failures)' from V$SYSSTAT
Dim lngSessionCacheHitsLast As Long         'Previous value of 'session cursor cache hits' from V$SYSSTAT

Dim dblDBCPU As Double                      'Current value of DB CPU from V$SYS_TIME_MODEL
Dim dblDBTime As Double                     'Current value of DB time from V$SYS_TIME_MODEL
Dim dblJavaTime As Double                   'Current value of Java execution elapsed time from V$SYS_TIME_MODEL
Dim dblPLSQLCompile As Double               'Current value of PL/SQL compilation elapsed time from V$SYS_TIME_MODEL
Dim dblPLSQLExecution As Double             'Current value of PL/SQL execution elapsed time from V$SYS_TIME_MODEL
Dim dblRMANCPU As Double                    'Current value of RMAN cpu time (backup/restore) from V$SYS_TIME_MODEL
Dim dblBackgroundCPU As Double              'Current value of background cpu time from V$SYS_TIME_MODEL
Dim dblBackgroundElapsed As Double          'Current value of background elapsed time from V$SYS_TIME_MODEL
Dim dblConnectMgmt As Double                'Current value of connection management call elapsed time from V$SYS_TIME_MODEL
Dim dblFailedParseMemory As Double          'Current value of failed parse (out of shared memory) elapsed time from V$SYS_TIME_MODEL
Dim dblFailedParseElapsed As Double         'Current value of failed parse elapsed time from V$SYS_TIME_MODEL
Dim dblHardParseBind As Double              'Current value of hard parse (bind mismatch) elapsed time from V$SYS_TIME_MODEL
Dim dblHardParseSharing As Double           'Current value of hard parse (sharing criteria) elapsed time from V$SYS_TIME_MODEL
Dim dblHardParseElapsed As Double           'Current value of hard parse elapsed time from V$SYS_TIME_MODEL
Dim dblInboundPLSQL As Double               'Current value of inbound PL/SQL rpc elapsed time from V$SYS_TIME_MODEL
Dim dblParseTimeElapsed As Double           'Current value of parse time elapsed from V$SYS_TIME_MODEL
Dim dblRepeatedBind As Double               'Current value of repeated bind elapsed time from V$SYS_TIME_MODEL
Dim dblSequenceLoad As Double               'Current value of sequence load elapsed time from V$SYS_TIME_MODEL
Dim dblSQLExecuteTime As Double             'Current value of sql execute elapsed time from V$SYS_TIME_MODEL

Dim dblDBCPULast As Double                  'Last value of DB CPU from V$SYS_TIME_MODEL
Dim dblDBTimeLast As Double                 'Last value of DB time from V$SYS_TIME_MODEL
Dim dblJavaTimeLast As Double               'Last value of Java execution elapsed time from V$SYS_TIME_MODEL
Dim dblPLSQLCompileLast As Double           'Last value of PL/SQL compilation elapsed time from V$SYS_TIME_MODEL
Dim dblPLSQLExecutionLast As Double         'Last value of PL/SQL execution elapsed time from V$SYS_TIME_MODEL
Dim dblRMANCPULast As Double                'Last value of RMAN cpu time (backup/restore) from V$SYS_TIME_MODEL
Dim dblBackgroundCPULast As Double          'Last value of background cpu time from V$SYS_TIME_MODEL
Dim dblBackgroundElapsedLast As Double      'Last value of background elapsed time from V$SYS_TIME_MODEL
Dim dblConnectMgmtLast As Double            'Last value of connection management call elapsed time from V$SYS_TIME_MODEL
Dim dblFailedParseMemoryLast As Double      'Last value of failed parse (out of shared memory) elapsed time from V$SYS_TIME_MODEL
Dim dblFailedParseElapsedLast As Double     'Last value of failed parse elapsed time from V$SYS_TIME_MODEL
Dim dblHardParseBindLast As Double          'Last value of hard parse (bind mismatch) elapsed time from V$SYS_TIME_MODEL
Dim dblHardParseSharingLast As Double       'Last value of hard parse (sharing criteria) elapsed time from V$SYS_TIME_MODEL
Dim dblHardParseElapsedLast As Double       'Last value of hard parse elapsed time from V$SYS_TIME_MODEL
Dim dblInboundPLSQLLast As Double           'Last value of inbound PL/SQL rpc elapsed time from V$SYS_TIME_MODEL
Dim dblParseTimeElapsedLast As Double       'Last value of parse time elapsed from V$SYS_TIME_MODEL
Dim dblRepeatedBindLast As Double           'Last value of repeated bind elapsed time from V$SYS_TIME_MODEL
Dim dblSequenceLoadLast As Double           'Last value of sequence load elapsed time from V$SYS_TIME_MODEL
Dim dblSQLExecuteTimeLast As Double         'Last value of sql execute elapsed time from V$SYS_TIME_MODEL

Dim intSessionCount As Integer              'Number of sessions logged
Dim intSessionCurrent As Integer            'Index of the current session
Dim lngSIDLast As Long                      'SID for the previous row from the database
Dim lngSerialLast As Long                   'SERIAL# for the previous row
Dim intSessionExists(999) As Integer        'Used to determine if the session is still found in the system
Dim lngSID(999) As Long                     'SID for session
Dim lngSerial(999) As Long                  'SERIAL# for the session
Dim strSessionOther(999) As String          'USERNAME, MACHINE, PROGRAM
Dim strSQLID(999) As String                 'SQL_ID and CHILD_NUMBER for the session
Dim dblSessionWait(999, 999) As Double           'Session Amount of time waited by the session in the selected wait event (wait#, session#)
Dim dblSessionWaitValue(999, 999) As Double      'Session wait event total time (wait#, session#)
Dim dblSessionWaitWaitsValue(999, 999) As Double 'Session wait event number of waits (wait#, session#)
Dim dblSessionWaitTOValue(999, 999) As Double    'Session wait event number of timeouts (wait#, session#)

Dim strSessionWaitEvent As String           'Name of the monitored wait event
Dim dblDBCPUS(999) As Double                'Current value of DB CPU from V$SESS_TIME_MODEL
Dim dblDBTimeS(999) As Double               'Current value of DB time from V$SESS_TIME_MODEL
Dim dblJavaTimeS(999) As Double             'Current value of Java execution elapsed time from V$SESS_TIME_MODEL
Dim dblPLSQLCompileS(999) As Double         'Current value of PL/SQL compilation elapsed time from V$SESS_TIME_MODEL
Dim dblPLSQLExecutionS(999) As Double       'Current value of PL/SQL execution elapsed time from V$SESS_TIME_MODEL
Dim dblRMANCPUS(999) As Double              'Current value of RMAN cpu time (backup/restore) from V$SESS_TIME_MODEL
Dim dblBackgroundCPUS(999) As Double        'Current value of background cpu time from V$SESS_TIME_MODEL
Dim dblBackgroundElapsedS(999) As Double    'Current value of background elapsed time from V$SESS_TIME_MODEL
Dim dblConnectMgmtS(999) As Double          'Current value of connection management call elapsed time from V$SESS_TIME_MODEL
Dim dblFailedParseMemoryS(999) As Double    'Current value of failed parse (out of shared memory) elapsed time from V$SESS_TIME_MODEL
Dim dblFailedParseElapsedS(999) As Double   'Current value of failed parse elapsed time from V$SESS_TIME_MODEL
Dim dblHardParseBindS(999) As Double        'Current value of hard parse (bind mismatch) elapsed time from V$SESS_TIME_MODEL
Dim dblHardParseSharingS(999) As Double     'Current value of hard parse (sharing criteria) elapsed time from V$SESS_TIME_MODEL
Dim dblHardParseElapsedS(999) As Double     'Current value of hard parse elapsed time from V$SESS_TIME_MODEL
Dim dblInboundPLSQLS(999) As Double         'Current value of inbound PL/SQL rpc elapsed time from V$SESS_TIME_MODEL
Dim dblParseTimeElapsedS(999) As Double     'Current value of parse time elapsed from V$SESS_TIME_MODEL
Dim dblRepeatedBindS(999) As Double         'Current value of repeated bind elapsed time from V$SESS_TIME_MODEL
Dim dblSequenceLoadS(999) As Double         'Current value of sequence load elapsed time from V$SESS_TIME_MODEL
Dim dblSQLExecuteTimeS(999) As Double       'Current value of sql execute elapsed time from V$SESS_TIME_MODEL

Dim dblDBCPUSLast(999) As Double                 'Last value of DB CPU from V$SESS_TIME_MODEL
Dim dblDBTimeSLast(999) As Double                'Last value of DB time from V$SESS_TIME_MODEL
Dim dblJavaTimeSLast(999) As Double              'Last value of Java execution elapsed time from V$SESS_TIME_MODEL
Dim dblPLSQLCompileSLast(999) As Double          'Last value of PL/SQL compilation elapsed time from V$SESS_TIME_MODEL
Dim dblPLSQLExecutionSLast(999) As Double        'Last value of PL/SQL execution elapsed time from V$SESS_TIME_MODEL
Dim dblRMANCPUSLast(999) As Double               'Last value of RMAN cpu time (backup/restore) from V$SESS_TIME_MODEL
Dim dblBackgroundCPUSLast(999) As Double         'Last value of background cpu time from V$SESS_TIME_MODEL
Dim dblBackgroundElapsedSLast(999) As Double     'Last value of background elapsed time from V$SESS_TIME_MODEL
Dim dblConnectMgmtSLast(999) As Double           'Last value of connection management call elapsed time from V$SESS_TIME_MODEL
Dim dblFailedParseMemorySLast(999) As Double     'Last value of failed parse (out of shared memory) elapsed time from V$SESS_TIME_MODEL
Dim dblFailedParseElapsedSLast(999) As Double    'Last value of failed parse elapsed time from V$SESS_TIME_MODEL
Dim dblHardParseBindSLast(999) As Double         'Last value of hard parse (bind mismatch) elapsed time from V$SESS_TIME_MODEL
Dim dblHardParseSharingSLast(999) As Double      'Last value of hard parse (sharing criteria) elapsed time from V$SESS_TIME_MODEL
Dim dblHardParseElapsedSLast(999) As Double      'Last value of hard parse elapsed time from V$SESS_TIME_MODEL
Dim dblInboundPLSQLSLast(999)                    'Last value of inbound PL/SQL rpc elapsed time from V$SESS_TIME_MODEL
Dim dblParseTimeElapsedSLast(999)                'Last value of parse time elapsed from V$SESS_TIME_MODEL
Dim dblRepeatedBindSLast(999)                    'Last value of repeated bind elapsed time from V$SESS_TIME_MODEL
Dim dblSequenceLoadSLast(999)                    'Last value of sequence load elapsed time from V$SESS_TIME_MODEL
Dim dblSQLExecuteTimeSLast(999)                  'Last value of sql execute elapsed time from V$SESS_TIME_MODEL

Dim intWaitCount As Integer                 'Number of wait events read from the database
Dim intWaitCurrent As Integer               'Current index of the wait event
Dim strWaitEventName(1300) As String        'Name of the wait event
Dim strWaitEventClass(1300) As String       'Wait Class of the wait event
Dim dblWaitValue(1300) As Double            'Current wait event total time
Dim dblWaitValueLast(1300) As Double        'Previous wait event total time
Dim dblWaitWaitsValue(1300) As Double       'Current wait event number of waits
Dim dblWaitWaitsValueLast(1300) As Double   'Previous wait event number of waits
Dim dblWaitTOValue(1300) As Double          'Current wait event number of timeouts
Dim dblWaitTOValueLast(1300) As Double      'Previous wait event number of timeouts

Dim snpDataWait As ADODB.Recordset          'ADO recordset used to query V$SYSTEM_EVENT
Dim comDataWait As ADODB.Command            'ADO command object used to retrieve data from V$SYSTEM_EVENT
Dim snpDataOSStat As ADODB.Recordset        'ADO recordset used to query V$OSSTAT
Dim comDataOSStat As ADODB.Command          'ADO command object used to retrieve data from V$OSSTAT
Dim snpDataSysTime As ADODB.Recordset       'ADO recordset used to query V$SYS_TIME_MODEL
Dim comDataSysTime As ADODB.Command         'ADO command object used to retrieve from V$SYS_TIME_MODEL
Dim snpDataSessTime As ADODB.Recordset      'ADO recordset used to query V$SESS_TIME_MODEL
Dim comDataSessTime As ADODB.Command        'ADO command object used to retrieve from V$SESS_TIME_MODEL
Dim comTrace As ADODB.Command               'ADO command object used to enable a 10046 trace
Dim snpXPLAN As ADODB.Recordset             'ADO Recordset object used to retrieve the execution plan
Dim comXPLAN As ADODB.Command               'ADO command object used to retrieve the execution plan
Dim snpSQLChildReason As ADODB.Recordset    'ADO recordset object used to retrieve the reason for the child cursor
Dim comSQLChildReason As ADODB.Command      'ADO command object used to retrieve the reason for the child cursor
Dim snpSQLChildBind As ADODB.Recordset      'ADO recordset object used to retrieve the bind variable definitions
Dim comSQLChildBind As ADODB.Command        'ADO command object used to retrieve the bind variable definitions
Dim snpSessionWait As ADODB.Recordset       'ADO recordset object used to retrieve the session level waits
Dim comSessionWait As ADODB.Command         'ADO command object used to retrieve the session level waits
Dim snpSYSSTAT As ADODB.Recordset           'ADO recordset object used to retrieve the system level statistics from V$SYSSTAT
Dim comSYSSTAT As ADODB.Command             'ADO command object used to retrieve the system level statistics from V$SYSSTAT

Dim intActivated As Integer                 'Indicates whether or not the form is refreshed and ready for use
Dim intRefreshSeconds As Integer            'Minimum number of seconds to wait before the next refresh
Dim intRefreshCount As Integer              'Counter that indicates the number of elapsed seconds since the last refresh
Dim intPauseRefresh As Integer              'Indicates whether or not the refresh is paused
Dim intExcludeIdleWaits As Integer          'Indicates whether or not to exclude idle wait events 

Now change the UserForm_Initialize procedure so that it shows the following:

Private Sub UserForm_Initialize()
    Dim intResult As Integer
    Dim strUsername As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim strSQL As String

    On Error Resume Next

    'Database configuration
    strUsername = "MyUsername"
    strPassword = "MyPassword"
    strDatabase = "MyDB"

    Set dbDatabase = New ADODB.Connection

    dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase _
        & ";User ID=" & strUsername & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

    dbDatabase.ConnectionTimeout = 40
    dbDatabase.CursorLocation = adUseClient
    dbDatabase.Open

    If (dbDatabase.State <> 1) Or (Err <> 0) Then
        intResult = MsgBox("Could not connect to the database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Charles Hooper's Oracle Database Time Model Viewer")
        Exit Sub
    End If

    'More code will be copied here
    '
    '
    '
   
    TimerEvent
End Sub 

At this point, after replacing MyUsername, MyPassword, and MyDB (the DB name from the tnsnames.ora file) with the appropriate logon credentials for one of your databases, you should be able to verify that the database connection works by running the UserForm_Initialize subroutine, simply by pressing the F5 key on the keyboard.  If no error message appears on the screen, the macro is able to connect to the database.  Now that we have verified that database connectivity works as expected, let’s close the UserForm’s window and add a little more code to the UserForm_Initialize subroutine.  Move the cursor just above the ‘More code will be copied here line and press the Enter key a couple of times to move that line down a little.  Move the cursor back up to one of the blank lines and paste in the following code which sets up a couple of the SQL statements that will be used by this tool:

    lngTimerTriggerSeconds = 60
    sglSessionMinimumPercent = 0.1  '10% of the total for the time period needed to be included in the detail
    Set snpDataWait = New ADODB.Recordset
    Set comDataWait = New ADODB.Command
    Set snpDataOSStat = New ADODB.Recordset
    Set comDataOSStat = New ADODB.Command
    Set snpDataSysTime = New ADODB.Recordset
    Set comDataSysTime = New ADODB.Command
    Set snpDataSessTime = New ADODB.Recordset
    Set comDataSessTime = New ADODB.Command
    Set comTrace = New ADODB.Command
    Set snpXPLAN = New ADODB.Recordset
    Set comXPLAN = New ADODB.Command
    Set snpSQLChildReason = New ADODB.Recordset
    Set comSQLChildReason = New ADODB.Command
    Set snpSQLChildBind = New ADODB.Recordset
    Set comSQLChildBind = New ADODB.Command
    Set snpSessionWait = New ADODB.Recordset
    Set comSessionWait = New ADODB.Command
    Set snpSYSSTAT = New ADODB.Recordset
    Set comSYSSTAT = New ADODB.Command

    With comDataOSStat
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  STAT_NAME," & vbCrLf
        strSQL = strSQL & "  VALUE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$OSSTAT" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  STAT_NAME IN ('NUM_CPUS','IDLE_TIME','BUSY_TIME','USER_TIME','SYS_TIME')"

        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30
        .ActiveConnection = dbDatabase
    End With

    With comDataSysTime
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  VALUE," & vbCrLf
        strSQL = strSQL & "  STAT_NAME" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SYS_TIME_MODEL"

        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30
        .ActiveConnection = dbDatabase
    End With

    With comDataSessTime
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  S.SID," & vbCrLf
        strSQL = strSQL & "  S.SERIAL#," & vbCrLf
        strSQL = strSQL & "  S.STATUS," & vbCrLf
        strSQL = strSQL & "  NVL(S.USERNAME,' ') USERNAME," & vbCrLf
        strSQL = strSQL & "  NVL(S.MACHINE,' ') MACHINE," & vbCrLf
        strSQL = strSQL & "  NVL(S.PROGRAM,' ') PROGRAM," & vbCrLf
        strSQL = strSQL & "  NVL(S.SQL_ID,NVL(S.PREV_SQL_ID,' ')) SQL_ID," & vbCrLf
        strSQL = strSQL & "  NVL(S.SQL_CHILD_NUMBER,NVL(S.PREV_CHILD_NUMBER,0)) SQL_CHILD_NUMBER," & vbCrLf
        strSQL = strSQL & "  STM.VALUE," & vbCrLf
        strSQL = strSQL & "  STM.STAT_NAME" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SESS_TIME_MODEL STM," & vbCrLf
        strSQL = strSQL & "  V$SESSION S" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  S.SID=STM.SID" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  S.USERNAME," & vbCrLf
        strSQL = strSQL & "  S.PROGRAM," & vbCrLf
        strSQL = strSQL & "  S.SID"

        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30
        .ActiveConnection = dbDatabase
    End With

    With comSYSSTAT
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  NAME," & vbCrLf
        strSQL = strSQL & "  VALUE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SYSSTAT" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  NAME IN ('CPU used by this session','parse time cpu','recursive cpu usage','parse count (total)','parse count (hard)','parse count (failures)','session cursor cache hits')"

        .CommandText = strSQL
        .CommandType = adCmdText
        .ActiveConnection = dbDatabase
    End With 

We will add more later, but that is sufficient for a starting point.  Just below the End Sub in the UserForm_Initialize procedure, add the following code, which will perform clean up when the UserForm is closed:

Private Sub UserForm_Terminate()
    intKillFlag = True

    If dbDatabase.State = 1 Then
        dbDatabase.Close
    End If

    Set snpDataWait = Nothing
    Set comDataWait = Nothing
    Set snpDataOSStat = Nothing
    Set comDataOSStat = Nothing
    Set snpDataSysTime = Nothing
    Set comDataSysTime = Nothing
    Set snpDataSessTime = Nothing
    Set comDataSessTime = Nothing
    Set comTrace = Nothing
    Set snpXPLAN = Nothing
    Set comXPLAN = Nothing
    Set snpSQLChildReason = Nothing
    Set comSQLChildReason = Nothing
    Set snpSQLChildBind = Nothing
    Set comSQLChildBind = Nothing
    Set snpSessionWait = Nothing
    Set comSessionWait = Nothing
    Set snpSYSSTAT = Nothing
    Set comSYSSTAT = Nothing
    Set dbDatabase = Nothing
End Sub

Let’s switch back to the design of the UserForm (if you cannot see the UserForm’s window, right-click frmTimeModel below Microsoft Excel Objects and select View Object from the menu), where we will add a couple of labels to the form.  This will be a little time consuming, but if you create one of the white box labels and a heading label, you can copy and paste the two labels as many times as is necessary (hold down the shift key to select more than one label to copy).  We will need a total of 11 labels with BackColor property set to &H00FFFFFF&  (white) and with the BorderStyle property set to 1 – fmBorderStyleSingle and with the TextAlign property set to 3 – fmTextAlignRight – we will also need a total of 11 plain labels with the TextAlign property set to 2 – fmTextAlignCenter

Set the (Name) property of the white background labels using the following list (one name per label): lblCPUs, lblBusyTime, lblIdleTime, lblBusyPercent, lblUserMode, lblKernelMode, lblUserModePercent, lblCPUUsedBySession, lblParseTimeCPU, lblRecursiveCPUUsage, lblOtherCPU

For the 11 plain labels with the centered text, change the Caption property of those labels to identify the contents (such as CPUs, Busy Time, etc.) of the closest white background label.  When the additions are complete, your UserForm might look something like the picture below:

Now we need to switch back to the code for the frmTimeModel UserForm and add a little more code to actually query the database.  Scroll up toward the top of the code in the UserForm, and locate this line:

Dim intExcludeIdleWaits As Integer          'Indicates whether or not to exclude idle wait events 

Move the cursor to the end of that line and press the Enter key a couple of times to add a couple of blank lines.  On one of the new blank lines paste the following code, which will query the database when executed:

Public Sub ReadData()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim strSQL As String

    On Error Resume Next

    dteLastUpdateDate = Now

    Set snpDataOSStat = comDataOSStat.Execute
    If Not (snpDataOSStat Is Nothing) Then
        Do While Not (snpDataOSStat.EOF)
          Select Case CStr(snpDataOSStat("stat_name"))
            Case "NUM_CPUS"
              intNumCPUs = CInt(snpDataOSStat("value"))
            Case "IDLE_TIME"
              dblIdleTimeLast = dblIdleTime
              dblIdleTime = CDbl(snpDataOSStat("value"))
            Case "BUSY_TIME"
              dblBusyTimeLast = dblBusyTime
              dblBusyTime = CDbl(snpDataOSStat("value"))
            Case "USER_TIME"
              dblUserTimeLast = dblUserTime
              dblUserTime = CDbl(snpDataOSStat("value"))
            Case "SYS_TIME"
              dblSysTimeLast = dblSysTime
              dblSysTime = CDbl(snpDataOSStat("value"))
          End Select

          snpDataOSStat.MoveNext
        Loop
    End If

    Set snpDataSysTime = comDataSysTime.Execute
    If Not (snpDataSysTime Is Nothing) Then
        Do While Not (snpDataSysTime.EOF)
          Select Case CStr(snpDataSysTime("stat_name"))
            Case "DB CPU"
              dblDBCPULast = dblDBCPU
              dblDBCPU = CDbl(snpDataSysTime("value"))
            Case "DB time"
              dblDBTimeLast = dblDBTime
              dblDBTime = CDbl(snpDataSysTime("value"))
            Case "Java execution elapsed time"
              dblJavaTimeLast = dblJavaTime
              dblJavaTime = CDbl(snpDataSysTime("value"))
            Case "PL/SQL compilation elapsed time"
              dblPLSQLCompileLast = dblPLSQLCompile
              dblPLSQLCompile = CDbl(snpDataSysTime("value"))
            Case "PL/SQL execution elapsed time"
              dblPLSQLExecutionLast = dblPLSQLExecution
              dblPLSQLExecution = CDbl(snpDataSysTime("value"))
            Case "RMAN cpu time (backup/restore)"
              dblRMANCPULast = dblRMANCPU
              dblRMANCPU = CDbl(snpDataSysTime("value"))
            Case "background cpu time"
              dblBackgroundCPULast = dblBackgroundCPU
              dblBackgroundCPU = CDbl(snpDataSysTime("value"))
            Case "background elapsed time"
              dblBackgroundElapsedLast = dblBackgroundElapsed
              dblBackgroundElapsed = CDbl(snpDataSysTime("value"))
            Case "connection management call elapsed time"
              dblConnectMgmtLast = dblConnectMgmt
              dblConnectMgmt = CDbl(snpDataSysTime("value"))
            Case "failed parse (out of shared memory) elapsed time"
              dblFailedParseMemoryLast = dblFailedParseMemory
              dblFailedParseMemory = CDbl(snpDataSysTime("value"))
            Case "failed parse elapsed time"
              dblFailedParseElapsedLast = dblFailedParseElapsed
              dblFailedParseElapsed = CDbl(snpDataSysTime("value"))
            Case "hard parse (bind mismatch) elapsed time"
              dblHardParseBindLast = dblHardParseBind
              dblHardParseBind = CDbl(snpDataSysTime("value"))
            Case "hard parse (sharing criteria) elapsed time"
              dblHardParseSharingLast = dblHardParseSharing
              dblHardParseSharing = CDbl(snpDataSysTime("value"))
            Case "hard parse elapsed time"
              dblHardParseElapsedLast = dblHardParseElapsed
              dblHardParseElapsed = CDbl(snpDataSysTime("value"))
            Case "inbound PL/SQL rpc elapsed time"
              dblInboundPLSQLLast = dblInboundPLSQL
              dblInboundPLSQL = CDbl(snpDataSysTime("value"))
            Case "parse time elapsed"
              dblParseTimeElapsedLast = dblParseTimeElapsed
              dblParseTimeElapsed = CDbl(snpDataSysTime("value"))
            Case "repeated bind elapsed time"
              dblRepeatedBindLast = dblRepeatedBind
              dblRepeatedBind = CDbl(snpDataSysTime("value"))
            Case "sequence load elapsed time"
              dblSequenceLoadLast = dblSequenceLoad
              dblSequenceLoad = CDbl(snpDataSysTime("value"))
            Case "sql execute elapsed time"
              dblSQLExecuteTimeLast = dblSQLExecuteTime
              dblSQLExecuteTime = CDbl(snpDataSysTime("value"))
          End Select

          snpDataSysTime.MoveNext
        Loop
    End If

    For j = 1 To intSessionCount
        intSessionExists(j) = False
    Next j

    Set snpDataSessTime = comDataSessTime.Execute
    If Not (snpDataSessTime Is Nothing) Then
        Do While Not (snpDataSessTime.EOF)
          'Find the matching session's previous statistics
          If (lngSIDLast <> CLng(snpDataSessTime("sid"))) Or (lngSerialLast <> CLng(snpDataSessTime("serial#"))) Then
            'This is a different session, see if the session was previously captured
            lngSIDLast = CLng(snpDataSessTime("sid"))
            lngSerialLast = CLng(snpDataSessTime("serial#"))

            intSessionCurrent = intSessionCount + 1
            For j = 1 To intSessionCount
              If (lngSID(j) = CLng(snpDataSessTime("sid"))) And (lngSerial(j) = CLng(snpDataSessTime("serial#"))) Then
                intSessionCurrent = j
                Exit For
              End If
            Next j
            If intSessionCurrent = intSessionCount + 1 Then
              intSessionCount = intSessionCount + 1
              lngSID(intSessionCurrent) = CLng(snpDataSessTime("sid"))
              lngSerial(intSessionCurrent) = CLng(snpDataSessTime("serial#"))
              strSessionOther(intSessionCurrent) = CStr(snpDataSessTime("machine")) & " ~ " & _
                 CStr(snpDataSessTime("username")) & " ~ " & _
                 CStr(snpDataSessTime("program")) & " ~ "
              If snpDataSessTime("sql_id") <> " " Then
                strSessionOther(intSessionCurrent) = strSessionOther(intSessionCurrent) & "SQL_ID/Child: " & _
                  CStr(snpDataSessTime("sql_id")) & "/" & CStr(snpDataSessTime("sql_child_number"))
                If UCase(snpDataSessTime("status")) = "ACTIVE" Then
                    strSessionOther(intSessionCurrent) = strSessionOther(intSessionCurrent) & " (A)"
                End If
                strSQLID(intSessionCurrent) = CStr(snpDataSessTime("sql_id")) & "/" & CStr(snpDataSessTime("sql_child_number"))
              Else
                strSQLID(intSessionCurrent) = ""
              End If
            End If
          End If

          intSessionExists(intSessionCurrent) = True
          Select Case CStr(snpDataSessTime("stat_name"))
            Case "DB CPU"
              dblDBCPUSLast(intSessionCurrent) = dblDBCPUS(intSessionCurrent)
              dblDBCPUS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "DB time"
              dblDBTimeSLast(intSessionCurrent) = dblDBTimeS(intSessionCurrent)
              dblDBTimeS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "Java execution elapsed time"
              dblJavaTimeSLast(intSessionCurrent) = dblJavaTimeS(intSessionCurrent)
              dblJavaTimeS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "PL/SQL compilation elapsed time"
              dblPLSQLCompileSLast(intSessionCurrent) = dblPLSQLCompileS(intSessionCurrent)
              dblPLSQLCompileS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "PL/SQL execution elapsed time"
              dblPLSQLExecutionSLast(intSessionCurrent) = dblPLSQLExecutionS(intSessionCurrent)
              dblPLSQLExecutionS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "RMAN cpu time (backup/restore)"
              dblRMANCPUSLast(intSessionCurrent) = dblRMANCPUS(intSessionCurrent)
              dblRMANCPUS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "background cpu time"
              dblBackgroundCPUSLast(intSessionCurrent) = dblBackgroundCPUS(intSessionCurrent)
              dblBackgroundCPUS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "background elapsed time"
              dblBackgroundElapsedSLast(intSessionCurrent) = dblBackgroundElapsedS(intSessionCurrent)
              dblBackgroundElapsedS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "connection management call elapsed time"
              dblConnectMgmtSLast(intSessionCurrent) = dblConnectMgmtS(intSessionCurrent)
              dblConnectMgmtS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "failed parse (out of shared memory) elapsed time"
              dblFailedParseMemorySLast(intSessionCurrent) = dblFailedParseMemoryS(intSessionCurrent)
              dblFailedParseMemoryS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "failed parse elapsed time"
              dblFailedParseElapsedSLast(intSessionCurrent) = dblFailedParseElapsedS(intSessionCurrent)
              dblFailedParseElapsedS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "hard parse (bind mismatch) elapsed time"
              dblHardParseBindSLast(intSessionCurrent) = dblHardParseBindS(intSessionCurrent)
              dblHardParseBindS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "hard parse (sharing criteria) elapsed time"
              dblHardParseSharingSLast(intSessionCurrent) = dblHardParseSharingS(intSessionCurrent)
              dblHardParseSharingS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "hard parse elapsed time"
              dblHardParseElapsedSLast(intSessionCurrent) = dblHardParseElapsedS(intSessionCurrent)
              dblHardParseElapsedS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "inbound PL/SQL rpc elapsed time"
              dblInboundPLSQLSLast(intSessionCurrent) = dblInboundPLSQLS(intSessionCurrent)
              dblInboundPLSQLS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "parse time elapsed"
              dblParseTimeElapsedSLast(intSessionCurrent) = dblParseTimeElapsedS(intSessionCurrent)
              dblParseTimeElapsedS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "repeated bind elapsed time"
              dblRepeatedBindSLast(intSessionCurrent) = dblRepeatedBindS(intSessionCurrent)
              dblRepeatedBindS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "sequence load elapsed time"
              dblSequenceLoadSLast(intSessionCurrent) = dblSequenceLoadS(intSessionCurrent)
              dblSequenceLoadS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
            Case "sql execute elapsed time"
              dblSQLExecuteTimeSLast(intSessionCurrent) = dblSQLExecuteTimeS(intSessionCurrent)
              dblSQLExecuteTimeS(intSessionCurrent) = CDbl(snpDataSessTime("value"))
          End Select

          snpDataSessTime.MoveNext
        Loop
        snpDataSessTime.Close
    End If

    Set snpSYSSTAT = comSYSSTAT.Execute
    If Not (snpSYSSTAT Is Nothing) Then
        Do While Not (snpSYSSTAT.EOF)
            Select Case snpSYSSTAT("name")
                Case "CPU used by this session"
                    dblCPUUsedByThisSessionLast = dblCPUUsedByThisSession
                    dblCPUUsedByThisSession = CDbl(snpSYSSTAT("value")) / 100
                Case "parse time cpu"
                    dblParseTimeCPULast = dblParseTimeCPU
                    dblParseTimeCPU = CDbl(snpSYSSTAT("value")) / 100
                Case "recursive cpu usage"
                    dblRecursiveCPUUsageLast = dblRecursiveCPUUsage
                    dblRecursiveCPUUsage = CDbl(snpSYSSTAT("value")) / 100
                Case "parse count (total)"
                    lngParseCountTotalLast = lngParseCountTotal
                    lngParseCountTotal = snpSYSSTAT("value")
                Case "parse count (hard)"
                    lngParseCountHardLast = lngParseCountHard
                    lngParseCountHard = snpSYSSTAT("value")
                Case "parse count (failures)"
                    lngParseCountFailuresLast = lngParseCountFailures
                    lngParseCountFailures = snpSYSSTAT("value")
                Case "session cursor cache hits"
                    lngSessionCacheHitsLast = lngSessionCacheHits
                    lngSessionCacheHits = snpSYSSTAT("value")
            End Select

            snpSYSSTAT.MoveNext
        Loop
        snpSYSSTAT.Close
    End If

    dteLastLoopStart = Now
End Sub 

As you are probably able to tell, the above code reads a lot of data from the database and places that data into variables.  Now we need code to display the query results on the UserForm.  Paste this code directly below the code that was just pasted:

Public Sub UpdateDisplay()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim sglColor As Single
    Dim lngResult As Long
    Dim dblDBTimeDelta As Double
    Dim dblBusyTimeSecondsDelta As Double
    Dim strAT As String
    Dim strOut As String
    Dim strLine As String
    Dim strLastWaitClass As String
    Dim intLastWaitClassRow As Integer
    Dim sglWaitClassTime As Single
    Dim sglTotalWaitTime As Single

    On Error Resume Next

    intActivated = False
'    If chkDisplaySessionDetail = 0 Then
'        intDisplaySessionDetail = False
'    Else
'        intDisplaySessionDetail = True
'    End If
'    sglSessionMinimumPercent = Val(cboSessionMinimumPercent.Text) / 100
    If sglSessionMinimumPercent = 0 Then
        sglSessionMinimumPercent = 0.1
    End If

    lblCPUs = Format(intNumCPUs)
    lblBusyTime = Format((dblBusyTime - dblBusyTimeLast) / 100, "0.00")
    lblIdleTime = Format((dblIdleTime - dblIdleTimeLast) / 100, "0.00")
    lblBusyPercent = Format(((dblBusyTime - dblBusyTimeLast) / ((dblBusyTime - dblBusyTimeLast) + (dblIdleTime - dblIdleTimeLast)) * 100), "0.00")
    lblUserMode = Format((dblUserTime - dblUserTimeLast) / 100, "0.00")
    lblKernelMode = Format((dblSysTime - dblSysTimeLast) / 100, "0.00")
    lblUserModePercent = Format(((dblUserTime - dblUserTimeLast) / ((dblUserTime - dblUserTimeLast) + (dblSysTime - dblSysTimeLast)) * 100), "0.00")

    lblCPUUsedBySession = Format(dblCPUUsedByThisSession - dblCPUUsedByThisSessionLast, "0.00")
    lblParseTimeCPU = Format(dblParseTimeCPU - dblParseTimeCPULast, "0.00")
    lblRecursiveCPUUsage = Format(dblRecursiveCPUUsage - dblRecursiveCPUUsageLast, "0.00")
    lblOtherCPU = Format((dblCPUUsedByThisSession - dblCPUUsedByThisSessionLast) - (dblParseTimeCPU - dblParseTimeCPULast) - (dblRecursiveCPUUsage - dblRecursiveCPUUsageLast), "0.00")

    dblBusyTimeSecondsDelta = (dblBusyTime - dblBusyTimeLast) / 100

    strAT = String(Len(Format(((dblBackgroundElapsed - dblBackgroundElapsedLast) + (dblDBTime - dblDBTimeLast)) / 1000000, "0.00")), "@")

    'tvTimeModel.Visible = False
    tvTimeModel.Nodes.Clear
    tvTimeModel.Nodes.Add , , "BackgroundElapsedTime", Format(Format((dblBackgroundElapsed - dblBackgroundElapsedLast) / 1000000, "0.00"), strAT) & " Background Elapsed Time"
    If ((dblBackgroundElapsed - dblBackgroundElapsedLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblBackgroundElapsedS(j) - dblBackgroundElapsedSLast(j)) / (dblBackgroundElapsed - dblBackgroundElapsedLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "BackgroundElapsedTime", tvwChild, "SESSIONBackgroundElapsedTime_" & Format(j), "-- " & Format(Format((dblBackgroundElapsedS(j) - dblBackgroundElapsedSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblBackgroundElapsedS(j) - dblBackgroundElapsedSLast(j)) / (dblBackgroundElapsed - dblBackgroundElapsedLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblBackgroundCPU - dblBackgroundCPULast) / 1000000, "0.00"), strAT) & " Background CPU Time"
    If (dblBackgroundElapsed - dblBackgroundElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblBackgroundCPU - dblBackgroundCPULast) / (dblBackgroundElapsed - dblBackgroundElapsedLast), "0.00%") & " of Background Time)"
    End If
    If dblBusyTimeSecondsDelta <> 0 Then
        strLine = strLine & " (" & Format((dblBackgroundCPU - dblBackgroundCPULast) / 1000000 / dblBusyTimeSecondsDelta, "0.00%") & " of Total Consumed Server CPU)"
    End If
    tvTimeModel.Nodes.Add "BackgroundElapsedTime", tvwChild, "BackgroundCPU", strLine
    If ((dblBackgroundCPU - dblBackgroundCPULast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblBackgroundCPUS(j) - dblBackgroundCPUSLast(j)) / (dblBackgroundCPU - dblBackgroundCPULast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "BackgroundCPU", tvwChild, "SESSIONBackgroundCPU_" & Format(j), "-- " & Format(Format((dblBackgroundCPUS(j) - dblBackgroundCPUSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblBackgroundCPUS(j) - dblBackgroundCPUSLast(j)) / (dblBackgroundCPU - dblBackgroundCPULast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblRMANCPU - dblRMANCPULast) / 1000000, "0.00"), strAT) & " RMAN CPU Time (Backup/Restore)"
    If (dblBackgroundElapsed - dblBackgroundElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblRMANCPU - dblRMANCPULast) / (dblBackgroundElapsed - dblBackgroundElapsedLast), "0.00%") & " of Background Time)"
    End If
    If (dblBackgroundCPU - dblBackgroundCPULast) <> 0 Then
        strLine = strLine & " (" & Format((dblRMANCPU - dblRMANCPULast) / (dblBackgroundCPU - dblBackgroundCPULast), "0.00%") & " of Background CPU)"
    End If
    If dblBusyTimeSecondsDelta <> 0 Then
        strLine = strLine & " (" & Format((dblRMANCPU - dblRMANCPULast) / 1000000 / dblBusyTimeSecondsDelta, "0.00%") & " of Total Consumed Server CPU)"
    End If
    tvTimeModel.Nodes.Add "BackgroundCPU", tvwChild, "RMANCPU", strLine
    If ((dblRMANCPU - dblRMANCPULast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblRMANCPUS(j) - dblRMANCPUSLast(j)) / (dblRMANCPU - dblRMANCPULast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "RMANCPU", tvwChild, "SESSIONRMANCPU_" & Format(j), "-- " & Format(Format((dblRMANCPUS(j) - dblRMANCPUSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblRMANCPUS(j) - dblRMANCPUSLast(j)) / (dblRMANCPU - dblRMANCPULast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    dblDBTimeDelta = dblDBTime - dblDBTimeLast
    tvTimeModel.Nodes.Add , , "DBTime", Format(Format((dblDBTime - dblDBTimeLast) / 1000000, "0.00"), strAT) & " DB Time"
    If ((dblDBTime - dblDBTimeLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblDBTimeS(j) - dblDBTimeSLast(j)) / (dblDBTime - dblDBTimeLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "DBTime", tvwChild, "SESSIONDBTime_" & Format(j), "-- " & Format(Format((dblDBTimeS(j) - dblDBTimeSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblDBTimeS(j) - dblDBTimeSLast(j)) / (dblDBTime - dblDBTimeLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblDBCPU - dblDBCPULast) / 1000000, "0.00"), strAT) & " DB CPU"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblDBCPU - dblDBCPULast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If dblBusyTimeSecondsDelta <> 0 Then
        strLine = strLine & " (" & Format((dblDBCPU - dblDBCPULast) / 1000000 / dblBusyTimeSecondsDelta, "0.00%") & " of Total Consumed Server CPU)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "DBCPU", strLine
    If ((dblDBCPU - dblDBCPULast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblDBCPUS(j) - dblDBCPUSLast(j)) / (dblDBCPU - dblDBCPULast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "DBCPU", tvwChild, "SESSIONDBCPU_" & Format(j), "-- " & Format(Format((dblDBCPUS(j) - dblDBCPUSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblDBCPUS(j) - dblDBCPUSLast(j)) / (dblDBCPU - dblDBCPULast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblConnectMgmt - dblConnectMgmtLast) / 1000000, "0.00"), strAT) & " Connection Management Call Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblConnectMgmt - dblConnectMgmtLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "ConnectionManagementCallElapsedTime", strLine
    If ((dblConnectMgmt - dblConnectMgmtLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblConnectMgmtS(j) - dblConnectMgmtSLast(j)) / (dblConnectMgmt - dblConnectMgmtLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "ConnectionManagementCallElapsedTime", tvwChild, "SESSIONConMgm_" & Format(j), "-- " & Format(Format((dblConnectMgmtS(j) - dblConnectMgmtSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblConnectMgmtS(j) - dblConnectMgmtSLast(j)) / (dblConnectMgmt - dblConnectMgmtLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblSequenceLoad - dblSequenceLoadLast) / 1000000, "0.00"), strAT) & " Sequence Load Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblSequenceLoad - dblSequenceLoadLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "SequenceLoadElapsedTime", strLine
    If ((dblSequenceLoad - dblSequenceLoadLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblSequenceLoadS(j) - dblSequenceLoadSLast(j)) / (dblSequenceLoad - dblSequenceLoadLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "SequenceLoadElapsedTime", tvwChild, "SESSIONSeqLoad_" & Format(j), "-- " & Format(Format((dblSequenceLoadS(j) - dblSequenceLoadSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblSequenceLoadS(j) - dblSequenceLoadSLast(j)) / (dblSequenceLoad - dblSequenceLoadLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblSQLExecuteTime - dblSQLExecuteTimeLast) / 1000000, "0.00"), strAT) & " SQL Execute Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblSQLExecuteTime - dblSQLExecuteTimeLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "SQLExecuteElapsedTime", strLine
    If ((dblSQLExecuteTime - dblSQLExecuteTimeLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblSQLExecuteTimeS(j) - dblSQLExecuteTimeSLast(j)) / (dblSQLExecuteTime - dblSQLExecuteTimeLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "SQLExecuteElapsedTime", tvwChild, "SESSIONSQLExec_" & Format(j), "-- " & Format(Format((dblSQLExecuteTimeS(j) - dblSQLExecuteTimeSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblSQLExecuteTimeS(j) - dblSQLExecuteTimeSLast(j)) / (dblSQLExecuteTime - dblSQLExecuteTimeLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblParseTimeElapsed - dblParseTimeElapsedLast) / 1000000, "0.00"), strAT) & " Parse Time Elapsed"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblParseTimeElapsed - dblParseTimeElapsedLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If (lngParseCountTotal - lngParseCountTotalLast) <> 0 Then
        strLine = strLine & " (" & Format(lngParseCountTotal - lngParseCountTotalLast) & " Total Parses, " & Format(lngParseCountHard - lngParseCountHardLast) & " Hard Parses, " & Format((lngParseCountTotal - lngParseCountTotalLast) - (lngParseCountHard - lngParseCountHardLast)) & " Soft Parses with " & (lngSessionCacheHits - lngSessionCacheHitsLast) & " Session Cache Cursor Hits, " & Format(lngParseCountFailures - lngParseCountFailuresLast) & " Failed Parses)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "ParseTimeElapsed", strLine
    If ((dblParseTimeElapsed - dblParseTimeElapsedLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblParseTimeElapsedS(j) - dblParseTimeElapsedSLast(j)) / (dblParseTimeElapsed - dblParseTimeElapsedLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "ParseTimeElapsed", tvwChild, "SESSIONParseTimeElapsed_" & Format(j), "-- " & Format(Format((dblParseTimeElapsedS(j) - dblParseTimeElapsedSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblParseTimeElapsedS(j) - dblParseTimeElapsedSLast(j)) / (dblParseTimeElapsed - dblParseTimeElapsedLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblHardParseElapsed - dblHardParseElapsedLast) / 1000000, "0.00"), strAT) & " Hard Parse Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseElapsed - dblHardParseElapsedLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If (dblParseTimeElapsed - dblParseTimeElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseElapsed - dblHardParseElapsedLast) / (dblParseTimeElapsed - dblParseTimeElapsedLast), "0.00%") & " of Parse Time)"
    End If
    If ((lngParseCountHard - lngParseCountHardLast) <> 0) And ((lngParseCountTotal - lngParseCountTotalLast) <> 0) Then
        strLine = strLine & " (" & Format((lngParseCountHard - lngParseCountHardLast) / (lngParseCountTotal - lngParseCountTotalLast), "0.00%") & " of All Parses are Hard Parses)"
    End If

    tvTimeModel.Nodes.Add "ParseTimeElapsed", tvwChild, "HardParseElapsedTime", strLine
    If ((dblHardParseElapsed - dblHardParseElapsedLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblHardParseElapsedS(j) - dblHardParseElapsedSLast(j)) / (dblHardParseElapsed - dblHardParseElapsedLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "HardParseElapsedTime", tvwChild, "SESSIONHardParseTimeElapsed_" & Format(j), "-- " & Format(Format((dblHardParseElapsedS(j) - dblHardParseElapsedSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblHardParseElapsedS(j) - dblHardParseElapsedSLast(j)) / (dblHardParseElapsed - dblHardParseElapsedLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblHardParseSharing - dblHardParseSharingLast) / 1000000, "0.00"), strAT) & " Hard Parse (Sharing Criteria) Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseSharing - dblHardParseSharingLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If (dblParseTimeElapsed - dblParseTimeElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseSharing - dblHardParseSharingLast) / (dblParseTimeElapsed - dblParseTimeElapsedLast), "0.00%") & " of Parse Time)"
    End If
    If (dblHardParseElapsed - dblHardParseElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseSharing - dblHardParseSharingLast) / (dblHardParseElapsed - dblHardParseElapsedLast), "0.00%") & " of Hard Parse Time)"
    End If
    tvTimeModel.Nodes.Add "HardParseElapsedTime", tvwChild, "HardParseSCElapsedTime", strLine
    If ((dblHardParseSharing - dblHardParseSharingLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblHardParseSharingS(j) - dblHardParseSharingSLast(j)) / (dblHardParseSharing - dblHardParseSharingLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "HardParseSCElapsedTime", tvwChild, "SESSIONHardParseSCEElapsedTime_" & Format(j), "-- " & Format(Format((dblHardParseSharingS(j) - dblHardParseSharingSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblHardParseSharingS(j) - dblHardParseSharingSLast(j)) / (dblHardParseSharing - dblHardParseSharingLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblHardParseBind - dblHardParseBindLast) / 1000000, "0.00"), strAT) & " Hard Parse (Bind Mismatch) Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseBind - dblHardParseBindLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If (dblParseTimeElapsed - dblParseTimeElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseBind - dblHardParseBindLast) / (dblParseTimeElapsed - dblParseTimeElapsedLast), "0.00%") & " of Parse Time)"
    End If
    If (dblHardParseElapsed - dblHardParseElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseBind - dblHardParseBindLast) / (dblHardParseElapsed - dblHardParseElapsedLast), "0.00%") & " of Hard Parse Time)"
    End If
    If (dblHardParseSharing - dblHardParseSharingLast) <> 0 Then
        strLine = strLine & " (" & Format((dblHardParseBind - dblHardParseBindLast) / (dblHardParseSharing - dblHardParseSharingLast), "0.00%") & " of Sharing Criteria Time)"
    End If
    tvTimeModel.Nodes.Add "HardParseSCElapsedTime", tvwChild, "HardParseBMElapsedTime", strLine
    If ((dblHardParseBind - dblHardParseBindLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblHardParseBindS(j) - dblHardParseBindSLast(j)) / (dblHardParseBind - dblHardParseBindLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "HardParseBMElapsedTime", tvwChild, "SESSIONHardParseBMElapsedTime_" & Format(j), "-- " & Format(Format((dblHardParseBindS(j) - dblHardParseBindSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblHardParseBindS(j) - dblHardParseBindSLast(j)) / (dblHardParseBind - dblHardParseBindLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblFailedParseElapsed - dblFailedParseElapsedLast) / 1000000, "0.00"), strAT) & " Failed Parse Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblFailedParseElapsed - dblFailedParseElapsedLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If (dblParseTimeElapsed - dblParseTimeElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblFailedParseElapsed - dblFailedParseElapsedLast) / (dblParseTimeElapsed - dblParseTimeElapsedLast), "0.00%") & " of Parse Time)"
    End If
    If ((lngParseCountFailures - lngParseCountFailuresLast) <> 0) And ((lngParseCountTotal - lngParseCountTotalLast) <> 0) Then
        strLine = strLine & " (" & Format((lngParseCountFailures - lngParseCountFailuresLast) / (lngParseCountTotal - lngParseCountTotalLast), "0.00%") & " of All Parses Failed)"
    End If
    tvTimeModel.Nodes.Add "ParseTimeElapsed", tvwChild, "FailedParseElapsedTime", strLine
    If ((dblFailedParseElapsed - dblFailedParseElapsedLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblFailedParseElapsedS(j) - dblFailedParseElapsedSLast(j)) / (dblFailedParseElapsed - dblFailedParseElapsedLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "FailedParseElapsedTime", tvwChild, "SESSIONFailedParseElapsedTime_" & Format(j), "-- " & Format(Format((dblFailedParseElapsedS(j) - dblFailedParseElapsedSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblFailedParseElapsedS(j) - dblFailedParseElapsedSLast(j)) / (dblFailedParseElapsed - dblFailedParseElapsedLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblFailedParseMemory - dblFailedParseMemoryLast) / 1000000, "0.00"), strAT) & " Failed Parse (Out of Shared Memory) Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblFailedParseMemory - dblFailedParseMemoryLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    If (dblParseTimeElapsed - dblParseTimeElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblFailedParseMemory - dblFailedParseMemoryLast) / (dblParseTimeElapsed - dblParseTimeElapsedLast), "0.00%") & " of Parse Time)"
    End If
    If (dblFailedParseElapsed - dblFailedParseElapsedLast) <> 0 Then
        strLine = strLine & " (" & Format((dblFailedParseMemory - dblFailedParseMemoryLast) / (dblFailedParseElapsed - dblFailedParseElapsedLast), "0.00%") & " of Failed Parse Time)"
    End If
    tvTimeModel.Nodes.Add "FailedParseElapsedTime", tvwChild, "FailedParseOutofSharedMemory", strLine
    If ((dblFailedParseMemory - dblFailedParseMemoryLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblFailedParseMemoryS(j) - dblFailedParseMemorySLast(j)) / (dblFailedParseMemory - dblFailedParseMemoryLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "FailedParseOutofSharedMemory", tvwChild, "SESSIONFailedParseMemory_" & Format(j), "-- " & Format(Format((dblFailedParseMemoryS(j) - dblFailedParseMemorySLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblFailedParseMemoryS(j) - dblFailedParseMemorySLast(j)) / (dblFailedParseMemory - dblFailedParseMemoryLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblPLSQLExecution - dblPLSQLExecutionLast) / 1000000, "0.00"), strAT) & " PL/SQL Execution Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblPLSQLExecution - dblPLSQLExecutionLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "PLSQLExecutionElapsedTime", strLine
    If ((dblPLSQLExecution - dblPLSQLExecutionLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblPLSQLExecutionS(j) - dblPLSQLExecutionSLast(j)) / (dblPLSQLExecution - dblPLSQLExecutionLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "PLSQLExecutionElapsedTime", tvwChild, "SESSIONPLSQLExecutionElapsedTime_" & Format(j), "-- " & Format(Format((dblPLSQLExecutionS(j) - dblPLSQLExecutionSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblPLSQLExecutionS(j) - dblPLSQLExecutionSLast(j)) / (dblPLSQLExecution - dblPLSQLExecutionLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblInboundPLSQL - dblInboundPLSQLLast) / 1000000, "0.00"), strAT) & " Inbound PL/SQL RPC Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblInboundPLSQL - dblInboundPLSQLLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "InboundPLSQLRPCElapsedTime", strLine
    If ((dblInboundPLSQL - dblInboundPLSQLLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblInboundPLSQLS(j) - dblInboundPLSQLSLast(j)) / (dblInboundPLSQL - dblInboundPLSQLLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "InboundPLSQLRPCElapsedTime", tvwChild, "SESSIONInboundPLSQLRPCElapsedTime_" & Format(j), "-- " & Format(Format((dblInboundPLSQLS(j) - dblInboundPLSQLSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblInboundPLSQLS(j) - dblInboundPLSQLSLast(j)) / (dblInboundPLSQL - dblInboundPLSQLLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblPLSQLCompile - dblPLSQLCompileLast) / 1000000, "0.00"), strAT) & " PL/SQL Compilation Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblPLSQLCompile - dblPLSQLCompileLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "PLSQLCompilationElapsedTime", strLine
    If ((dblPLSQLCompile - dblPLSQLCompileLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblPLSQLCompileS(j) - dblPLSQLCompileSLast(j)) / (dblPLSQLCompile - dblPLSQLCompileLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "PLSQLCompilationElapsedTime", tvwChild, "SESSIONPLSQLCompilationElapsedTime_" & Format(j), "-- " & Format(Format((dblPLSQLCompileS(j) - dblPLSQLCompileSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblPLSQLCompileS(j) - dblPLSQLCompileSLast(j)) / (dblPLSQLCompile - dblPLSQLCompileLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblJavaTime - dblJavaTimeLast) / 1000000, "0.00"), strAT) & " Java Execution Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblJavaTime - dblJavaTimeLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "JavaExecutionElapsedTime", strLine
    If ((dblJavaTime - dblJavaTimeLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblJavaTimeS(j) - dblJavaTimeSLast(j)) / (dblJavaTime - dblJavaTimeLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "JavaExecutionElapsedTime", tvwChild, "SESSIONJavaExecutionElapsedTime_" & Format(j), "-- " & Format(Format((dblJavaTimeS(j) - dblJavaTimeSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = Round((dblJavaTimeS(j) - dblJavaTimeSLast(j)) / (dblJavaTime - dblJavaTimeLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, 255 - sglColor, 0)
                End If
            End If
        Next j
    End If

    strLine = Format(Format((dblRepeatedBind - dblRepeatedBindLast) / 1000000, "0.00"), strAT) & " Repeated Bind Elapsed Time"
    If dblDBTimeDelta <> 0 Then
        strLine = strLine & " (" & Format((dblRepeatedBind - dblRepeatedBindLast) / dblDBTimeDelta, "0.00%") & " of DB Time)"
    End If
    tvTimeModel.Nodes.Add "DBTime", tvwChild, "RepeatedBindElapsedTime", strLine
    If ((dblRepeatedBind - dblRepeatedBindLast) <> 0) And (intDisplaySessionDetail = True) Then
        For j = 1 To intSessionCount
            If intSessionExists(j) = True Then
                If ((dblRepeatedBindS(j) - dblRepeatedBindSLast(j)) / (dblRepeatedBind - dblRepeatedBindLast) >= sglSessionMinimumPercent) Then
                    tvTimeModel.Nodes.Add "RepeatedBindElapsedTime", tvwChild, "SESSIONRepeatedBindElapsedTime_" & Format(j), "-- " & Format(Format((dblRepeatedBindS(j) - dblRepeatedBindSLast(j)) / 1000000, "0.00"), strAT) & "  SID: " & Format(lngSID(j)) & " Serial #: " & Format(lngSerial(j)) & " " & strSessionOther(j)
                    sglColor = 255 - Round((dblRepeatedBindS(j) - dblRepeatedBindSLast(j)) / (dblRepeatedBind - dblRepeatedBindLast) * 255)
                    If sglColor > 255 Then
                        sglColor = 255
                    Else
                        If sglColor < 0 Then
                            sglColor = 0
                        End If
                    End If
                    tvTimeModel.Nodes(tvTimeModel.Nodes.Count).BackColor = RGB(255, sglColor, 0)
                End If
            End If
        Next j
    End If

    For j = 1 To tvTimeModel.Nodes.Count
        'Force all of the nodes to appear expanded
         tvTimeModel.Nodes(j).Expanded = True
    Next j
    tvTimeModel.Nodes(1).Selected = True

    'tvTimeModel.Visible = True

    intCurrentSessionIndex = -1
    intActivated = True
End Sub 

We are almost ready to take the code for a test drive.  First, we need to make a couple of changes to the code in the TimerEvent subroutine.  That subroutine is found in Module1 under the Modules heading (which is below the Microsoft Excel Objects heading).  Double-click Module1 to display the code in that module.  Change the TimerEvent subroutine to look like this:

Public Sub TimerEvent()
    lngTimerEventCounter = lngTimerEventCounter + 1

    If intKillFlag = False Then
        If lngTimerTriggerSeconds <= lngTimerEventCounter Then
            lngTimerEventCounter = 0
            frmTimeModel.ReadData
            frmTimeModel.UpdateDisplay
        End If

        'Instruct Excel to execute the TimerEvent sub again in 1 second
        Application.OnTime DateAdd("s", 1, Now), "TimerEvent"
    End If
End Sub 

The above code tells Excel to execute the ReadData subroutine and then the UpdateData subroutine every time the number of elapsed seconds is equal to the value specified by the lngTimerTriggerSeconds variable, which is set to 60 by default in the code.

Save the Excel workbook, close the workbook, and then open the workbook again.  If everything works right, after about 60 seconds you should see the time model statistics for the previous 60 seconds, something like this:

Wow, that is a lot of code for what little is shown in the above screen capture.  We will continue from here in the next segment of the series.

—-

Added March 2, 2011:

The Excel project code to this point, save with a .XLS extension (currently has a .DOC extension, please change):
TimeModelViewerExcelArticle2.xls





Oracle Database Time Model Viewer in Excel 1

28 02 2011

February 28, 2011

(Forward to the Next Post in the Series)

Previously, I had written a couple of blog articles that showed how to build a reasonably usable Oracle Database Time Model Viewer using nothing more than a text file (containing a VBS script) and a dynamically generated web page that is displayed on a Windows client computer using Internet Explorer (see the three part series).  It might be interesting to see what is possible in a more sophisticated programming environment, such as Microsoft Excel.

170.64 seconds of CPU time consumed in 60 seconds, meaning that on average the CPUs were 34.97% busy, 20.18 seconds of CPU time were consumed in kernel mode, meaning that 88.17% of the CPU time consumed was consumed by Oracle Database or other foregound processes.  Interesting, but I could probably obtain roughly the same information from an operating system utility.  Possibly the more important question is “What is happening in my database instance?”  Before the time model statistics were introduced in Oracle Database 10.1, we could see by examining repeated samplings of V$SYSSTAT that 78.05 CPU seconds were consumed by the sessions (falling into the CPU used by session statistic), that 2.43 CPU seconds were needed parsing activity (falling into the parse time cpu statistic, and 2.90 CPU seconds were needed for recursive operations (falling into the recursive cpu usage statistic) while performing operations such as trigger execution and space management calls – we are able to drill down into the session level detail by comparing delta values of V$SESSTAT.  Starting with Oracle Database 9.2 we could also monitor the CPU usage of SQL statements by repeatedly checking V$SQL (Oracle Database 10.2 and above permit accessing V$SQLSTATS as a less resource intensive method to access much of the same information using the SQL_ID and PLAN_HASH_VALUE).  We could also check the various views (V$SYSTEM_EVENT, V$SESSION_EVENT, V$SESSION_WAIT, V$LOCK, etc.) that compose the wait event interface, but that information will not indicate the amount of CPU used, and why the CPU was used by a session.

Let’s see if it is possible to build an extended version of the Oracle Database Time Model Viewer in Excel, hopefully something like this – the screen capture includes a lot of cross-referenced information that extends well beyond the Oracle Database time model views (V$SYS_TIME_MODEL, V$SESS_TIME_MODEL):

If you look closely at the above picture, we also see that this Oracle Database instance accounted for 80.63 CPU seconds (Background CPU Time plus DB CPU), with SID 1230 consuming the greatest percentage of CPU time at 19.13 seconds.  Looking at the bottom of the screen capture, we see wait events from V$SYSTEM_EVENT and V$SESSION_EVENT that are grouped into categories (Administrative, Application, Commit, Concurrency, Configuration, Idle, Network, Other, Scheduler, System I/O, and User I/O), a feature which first appeared in Oracle Database 10.2.   The time model statistics show that session 1230 spent 24.98 seconds executing SQL statements, a portion of the time was spent running on the CPU (19.13 seconds), and a port of the time was spent sitting in wait events (6.47 seconds in the direct path read wait event).  Interesting possibilities here.

Let’s look at another example.  793.46 seconds of CPU time consumed in (roughly) 60 seconds, meaning that on average the CPUs were just under 100.00% busy, 11.60 seconds of CPU time were consumed in kernel mode, meaning that 98.54% of the CPU time consumed was consumed by Oracle Database or other foregound processes.  Fantastic, we are using 100% of the server’s CPUs (oh wait, that is not a good idea).  Unlike the earlier screen capture, where DB Time (125.86 seconds) was roughly equal to DB CPU (80.61 seconds) plus the value for Total Non-Idle Wait Time (43.74 seconds); in this screen capture we find that DB Time (259.40 seconds) seems to have a bit of lost time because the DB CPU (131.66 seconds) plus Total Non-Idle Wait Time (34.72 seconds) is about 93 seconds short of the DB Time statistic – on a positive note, if we were only looking at the wait events, it would appear that the sessions waited 9.02 seconds less in this time interval than in the time interval of the previous screen capture – we would have missed that the missing time detail if we had we not been looking at more than just the wait events :-) .  If we look at the delta values from V$OSSTAT (the statistics at the top of the screen captures), and compare those statistics to the DB CPU plus Background CPU Time time model statistics, we get a sense of what the problem might entail.  The V$OSSTATS statistics indicate that the processes running on the server (and the kernel mode CPU usage that was provoked by those processes) consumed 793.46 seconds of CPU time, while we are only able to account for 131.65 seconds + 0.08 seconds, or roughly 16.6% of the total CPU usage within the database instance.  A relevant question at this point is what process or processes consumed the other 83.4% of the CPU time?

Moving on to the third screen capture, we see that things have started calming down a a little, with the average CPU utilization for the 60 second time period at 89.24% busy – of course this probably means that there were periods of 100% utilization, and periods of 70% utilization (I cheated, I watched the CPU utilization in roughly 5 second intervals, but note that DB Time minus DB CPU minus Total Non-Idle Wait Time indicates that 36.86 seconds are apparently missing… or lost in the CPU run queue, or in an uninstrumented code path).  In the following screen capture we are able to see that the database instance consumed 203.77 seconds plus 0.03 seconds of the 439.56 seconds of total server CPU time consumed in the interval (roughly 46.4% of the total server CPU consumed could be attributed to the database instance – what else is consuming the server’s CPU time, possibly another database instance?).

By the time of the fourth screen capture things are starting to settle down, with the server’s CPUs just 24.58% busy.  Unfortunately, the database instance being monitored only accounted for 13.95% of that CPU usage, so some other process is still competing for the server’s CPU time.  Lots of pretty colors and other information in the screen captures, but we will save the explanation for later.

Let’s start up Excel and begin building the project – you will probably need the 32 bit version of Excel for this exercise, even on a 64 bit computer.  Right-click one of the worksheet tabs and click View Code.

From the Tools menu, select References.  Find Microsoft ActiveX Data Objects 2.8 (or 6.0) Library, and place a check next to that item.  This is the feature that will allow our macros to communicate with the Oracle Database.  Click OK.

Next, we need to create a window for our application, and in Excel that window is called a UserForm.  Right-click Microsoft Excel Objects, and then select Insert – UserForm from the menu.

From the View menu, select Properties Explorer.  Change the (Name) property of the UserForm to frmTimeModel and feel free to change the other form properties as you see fit.

Now the potentially challenging part.  We need a Microsoft Windows built-in 32 bit element (control) called TreeView.  This 32 bit control is found in the MSCOMCTL.OCX, and on a 32 bit operating system the file should be found in the C:\Windows\System32 folder.  On a 64 bit operating system the file should be found in the C:\Windows\SysWOW64 folder.  This file might be installed by various installer programs, but can also be downloaded from Microsoft (this link might also work, but the file is much older).  If you had to download the file, put it in the correct folder location and then “register” the file with Windows, using a command like this (on a 64 bit client computer):

REGSVR32 c:\windows\SysWOW64\MSCOMCTL.OCX 

(Possible bad news, the TreeView control might not work without Visual Basic 5.0 or 6.0 installed, see this article – we might need to simulate the TreeView using an Excel worksheet.)

Once we verify that the TreeView control is on the computer and registered, switch back to the Visual Basic editor, and from the Tools menu, select Additional Controls…  Locate one of the Microsoft TreeView Controls in the list and place a checkmark next to it.  Then click the OK button.

Find the TreeView control in the Toolbox tools list, and click it.  Draw a rectangle convering most of the UserForm.  In the Properties window, change the (Name) property of the TreeView control to tvTimeModel and then double-click the word (Custom) in the Properties window.  In the Properties Pages window, change the Line Style to 1 – tvwRootLines and then click the OK button.  Back in the Properties window, change the font to Courier New with an 8 point font size (to do this, double-click the word Font in the properties list).

Now, let’s add a little code to the project.  Earlier, when we added a UserForm to the project, we right-clicked Microsoft Excel Object.  In the same area of the screen is an item titled ThisWorkbook – double click the word ThisWorkbook.  Add the following code to the code window that appeared:

Private Sub Workbook_Open()
    'Code to initialize sheets should be placed here
    lngTimerTriggerSeconds = 60
    lngTimerEventCounter = lngTimerTriggerSeconds
    frmTimeModel.Show
End Sub 

The above code sets the values of a couple of variables that can be accessed throughout the Excel project and then tells Microsoft Excel to display the UserForm that we just created, every time this Excel spreadsheet workbook is opened.

Now let’s create a timer subroutine that will automatically run once a second.  Right-click Microsoft Excel Objects, and then select Insert – Module from the menu.  Add the following code to the new module:

Option Explicit
Public lngTimerEventCounter As Long
Public lngTimerTriggerSeconds As Long
Public intKillFlag As Integer
Public Sub TimerEvent()
    Dim i As Integer
    lngTimerEventCounter = lngTimerEventCounter + 1

    If lngTimerTriggerSeconds <= lngTimerEventCounter Then
        frmTimeModel.tvTimeModel.Nodes.Clear
        frmTimeModel.tvTimeModel.Nodes.Add , , "BackgroundElapsedTime", "This is a test, the time is now " & Now
        frmTimeModel.tvTimeModel.Nodes.Add "BackgroundElapsedTime", tvwChild, "BackgroundCPU", "The background is still in the background."

        For i = 1 To frmTimeModel.tvTimeModel.Nodes.Count
            'Force all of the nodes to appear expanded
            frmTimeModel.tvTimeModel.Nodes(i).Expanded = True
        Next i
        frmTimeModel.tvTimeModel.Nodes(1).Selected = True

        lngTimerEventCounter = 0
        intKillFlag = intKillFlag + 1
    End If
    'Instruct Excel to execute the TimerEvent sub again in 1 second
    If intKillFlag < 10 Then
        Application.OnTime DateAdd("s", 1, Now), "TimerEvent"
    End If
End Sub 

The above creates a sort of recursive routine, where every time the TimerEvent subroutine executes, it instructs Excel to execute the subroutine again after waiting one second.  Every 60 times the TimerEvent subroutine executes, it will update the TreeView control on the UserForm.  But there is a catch – somehow we need to execute the TimerEvent the first time so that it will automatically execute once a second.  Below where you previously found Microsoft Excel Objects you will see frmTimeModel.  Right-click frmTimeModel and select View Code.  Add the following code:

Private Sub UserForm_Initialize()
    TimerEvent
End Sub 

Now save the Excel spreadsheet workbook, exit Excel, and the open the spreadsheet workbook that we just created.  If everything works as it should, you should see something like this (note that you may need to adjust the Macro Security Level to allow the execution of all macros):

We will continue from here in the next segment of the series.

Edit February 28, 2011:
The current Excel project file, it might be necessary to hit the F5 key on the keyboard for the macro to run correctly after the workbook opens: TimeModelViewerExcelArticle1





Watching Consistent Gets – 10200 Trace File Parser

24 01 2011

January 24, 2011

It happened again, another blog article that forced me to stop, think, and … hey, why did Oracle Database 11.2.0.2 do something different than Oracle Database 10.2.0.5?  What is different, even when the OPTIMIZER_FEATURES_ENABLE parameter is set to 10.2.0.4 (or 10.2.0.5)?  The number of consistent gets for a SQL statement is significantly different – we did see a similar difference between release version before, but for a different reason.  We need the help of Oracle Database trace event 10200 to determine why there is a difference.  Once we have the trace file, we need an easy way to process the trace file.

Excel Macro that will work with a trace file produced by Oracle Database running on Windows (also works in Microsoft Visual Basic 6.0 and earlier; for an Oracle Database running on Unix/Linux, open the  trace file with Wordpad first, and then save the trace file using Wordpad):
(Replace c:\or10s_ora_4256_watch_consistent.trc with the actual name of the generated trace file – the script as written seems to work with 10.2.0.x and 11.2.0.x)

Private Sub Read_10200_Trace1()
    Dim intFileNum As Integer             '10200 trace file
    Dim intFileNum2 As Integer            'Output file
    Dim strInput As String                'Line read from the 10200 trace file
    Dim strOutput As String               'Line to be written to the output file
    Dim strBlock(2000) As String          'Block read from the trace file
    Dim strBlockCounter(2000) As Integer  'Number of times read
    Dim intBlocks As Integer              'Total number of blocks
    Dim i As Integer                      'Loop counter
    Dim intFound As Integer               'Indicates whether or not the block was found

    intFileNum = FreeFile
    Open "c:\or10s_ora_4256_watch_consistent.trc" For Input As #intFileNum

    intFileNum2 = FreeFile
    Open "c:\watch_consistent.txt" For Output As #intFileNum2

    Do While Not EOF(intFileNum)
        Line Input #intFileNum, strInput
        If InStr(strInput, "started for block") > 0 Then
            strOutput = Trim(Right(strInput, Len(strInput) - InStr(InStr(strInput, "started for block"), strInput, ":")))
            'Find the number of times the block was accessed
            intFound = 0
            For i = 1 To intBlocks
                If strOutput = strBlock(i) Then
                    intFound = i
                    strBlockCounter(i) = strBlockCounter(i) + 1
                    Exit For
                End If
            Next i
            'If the block was not found, record it
            If intFound = 0 Then
                intBlocks = intBlocks + 1
                intFound = intBlocks
                strBlockCounter(intBlocks) = 1
                strBlock(intBlocks) = strOutput
            End If
            Print #intFileNum2, strOutput; vbTab; strBlockCounter(intFound)
        End If
    Loop
    Print #intFileNum2, ""
    For i = 1 To intBlocks
        Print #intFileNum2, strBlock(i); vbTab; strBlockCounter(i)
    Next i
    Close #intFileNum
    Close #intFileNum2
End Sub 

Excel Macro equivalent that will work with a trace file produced by Oracle Database running on Windows/Unix/Linux (also works in Microsoft Visual Basic 6.0 and earlier):
(Replace c:\or10s_ora_4256_watch_consistent.trc with the actual name of the generated trace file)

Private Sub Read_10200_Trace2()
    Dim strInput As String                'Line read from the 10200 trace file
    Dim strOutput As String               'Line to be written to the output file
    Dim strBlock(2000) As String          'Block read from the trace file
    Dim strBlockCounter(2000) As Integer  'Number of times read
    Dim intBlocks As Integer              'Total number of blocks
    Dim i As Integer                      'Loop counter
    Dim intFound As Integer               'Indicates whether or not the block was found

    Dim objFSO As Object                  'FileSystemObjects
    Dim objFile1 As Object                'The FileSystemObjects handle to the raw 10020 trace file
    Dim objFile2 As Object                'The FileSystemObjects handle to the output file

    Const ForReading = 1
    Const ForWriting = 2

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile1 = objFSO.OpenTextFile("c:\or10s_ora_4256_watch_consistent.trc", ForReading)
    Set objFile2 = objFSO.CreateTextFile("c:\watch_consistent.txt", True)

    Do While Not (objFile1.AtEndOfStream)
        strInput = objFile1.ReadLine
        If InStr(strInput, "started for block") > 0 Then
            strOutput = Trim(Right(strInput, Len(strInput) - InStr(InStr(strInput, "started for block"), strInput, ":")))
            'Find the number of times the block was accessed
            intFound = 0
            For i = 1 To intBlocks
                If strOutput = strBlock(i) Then
                    intFound = i
                    strBlockCounter(i) = strBlockCounter(i) + 1
                    Exit For
                End If
            Next i
            'If the block was not found, record it
            If intFound = 0 Then
                intBlocks = intBlocks + 1
                intFound = intBlocks
                strBlockCounter(intBlocks) = 1
                strBlock(intBlocks) = strOutput
            End If
            objFile2.Write strOutput & vbTab & strBlockCounter(intFound) & vbCrLf
        End If
    Loop
    objFile2.Write "" & vbCrLf
    For i = 1 To intBlocks
        objFile2.Write strBlock(i) & vbTab & strBlockCounter(i) & vbCrLf
    Next i
    objFile1.Close
    objFile2.Close
End Sub 

VBS Script Equivalent that will work with a trace file produced by Oracle Database running on Windows/Unix/Linux (also works in Excel and Microsoft Visual Basic 6.0 and earlier):
(Replace c:\or10s_ora_4256_watch_consistent.trc with the actual name of the generated trace file)

Dim strInput                'Line read from the 10200 trace file
Dim strOutput               'Line to be written to the output file
Dim strBlock(2000)          'Block read from the trace file
Dim strBlockCounter(2000)   'Number of times read
Dim intBlocks               'Total number of blocks
Dim i                       'Loop counter
Dim intFound                'Indicates whether or not the block was found

Dim objFSO                  'FileSystemObjects
Dim objFile1                'The FileSystemObjects handle to the raw 10020 trace file
Dim objFile2                'The FileSystemObjects handle to the output file

Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile1 = objFSO.OpenTextFile("c:\or10s_ora_4256_watch_consistent.trc", ForReading)
Set objFile2 = objFSO.CreateTextFile("c:\watch_consistent.txt", True)

Do While Not (objFile1.AtEndOfStream)
    strInput = objFile1.ReadLine
    If InStr(strInput, "started for block") > 0 Then
        strOutput = Trim(Right(strInput, Len(strInput) - InStr(InStr(strInput, "started for block"), strInput, ":")))
        'Find the number of times the block was accessed
        intFound = 0
        For i = 1 To intBlocks
            If strOutput = strBlock(i) Then
                intFound = i
                strBlockCounter(i) = strBlockCounter(i) + 1
                Exit For
            End If
        Next
        'If the block was not found, record it
        If intFound = 0 Then
            intBlocks = intBlocks + 1
            intFound = intBlocks
            strBlockCounter(intBlocks) = 1
            strBlock(intBlocks) = strOutput
        End If
        objFile2.Write strOutput & vbTab & strBlockCounter(intFound) & vbCrLf
    End If
Loop
objFile2.Write "" & vbCrLf
For i = 1 To intBlocks
    objFile2.Write strBlock(i) & vbTab & strBlockCounter(i) & vbCrLf
Next
objFile1.Close
objFile2.Close 

—-

OK, now that we have the solution, we need an appropriate problem that must be solved with our solution.  The script below creates two test tables, each with a unique index on the ID column:

CREATE TABLE T1 AS
SELECT
  ROWNUM ID,
  TRUNC(DBMS_RANDOM.VALUE(1,300000)) N1,
  LPAD(ROWNUM,10,'0') SMALL_VC,
  RPAD('X',100) PADDING
FROM
  DUAL
CONNECT BY
  LEVEL <= 300000;

CREATE TABLE T2 AS
SELECT
  ROWNUM ID,
  TRUNC(DBMS_RANDOM.VALUE(1,300000)) N1,
  LPAD(ROWNUM,10,'0') SMALL_VC,
  RPAD('X',100) PADDING
FROM
  DUAL
CONNECT BY
  LEVEL <= 300000;

CREATE UNIQUE INDEX PAR_I1 ON T1(ID);
CREATE UNIQUE INDEX CHI_I1 ON T2(ID);

EXEC DBMS_STATS.GATHER_TABLE_STATS(OWNNAME=>USER,TABNAME=>'T1',CASCADE=>TRUE)
EXEC DBMS_STATS.GATHER_TABLE_STATS(OWNNAME=>USER,TABNAME=>'T2',CASCADE=>TRUE) 

Now for the test SQL statement (hinted to help force a specific execution plan):

ALTER SESSION SET OPTIMIZER_FEATURES_ENABLE='10.2.0.4';

SELECT /*+ GATHER_PLAN_STATISTICS LEADING(T1) USE_NL(T2) INDEX(T1) INDEX(T2) */
  T1.ID,
  T1.N1,
  T2.ID,
  T2.N1
FROM
  T1,
  T2
WHERE
  T1.ID=T2.ID
  AND T1.ID BETWEEN 1 AND 200
  AND T2.N1 = 0;

SELECT * FROM TABLE(DBMS_XPLAN.DISPLAY_CURSOR(NULL,NULL,'ALLSTATS LAST -ROWS -PREDICATE')); 

The execution plan that is output looks like this:

SQL_ID  1afa5ym56cagh, child number 0
-------------------------------------
SELECT /*+ GATHER_PLAN_STATISTICS LEADING(T1) USE_NL(T2) INDEX(T1) INDEX(T2) */
  T1.ID,   T1.N1,   T2.ID,   T2.N1 FROM   T1,   T2 WHERE   T1.ID=T2.ID   AND
T1.ID BETWEEN 1 AND 200   AND T2.N1 = 0

Plan hash value: 3072046012

----------------------------------------------------------------------------------------
| Id  | Operation                    | Name   | Starts | A-Rows |   A-Time   | Buffers |
----------------------------------------------------------------------------------------
|   0 | SELECT STATEMENT             |        |      1 |      0 |00:00:00.03 |     408 |
|   1 |  NESTED LOOPS                |        |      1 |      0 |00:00:00.03 |     408 |
|   2 |   TABLE ACCESS BY INDEX ROWID| T1     |      1 |    200 |00:00:00.01 |       6 |
|   3 |    INDEX RANGE SCAN          | PAR_I1 |      1 |    200 |00:00:00.01 |       2 |
|   4 |   TABLE ACCESS BY INDEX ROWID| T2     |    200 |      0 |00:00:00.02 |     402 |
|   5 |    INDEX UNIQUE SCAN         | CHI_I1 |    200 |    200 |00:00:00.01 |     202 |
---------------------------------------------------------------------------------------- 

In the above, there were 2 consistent gets for the PAR_I1 index, 4 consistent gets for the T1 table, 202 consistent gets for the CHI_I1 index, and 200 consistent gets for the T2 table.  While it might not be obvious from the above, the BLEVEL for both indexes is 1 (HEIGHT = 2 – see the quiz article linked to at the start of this article for an explanation).  When I first saw the quiz that is linked to at the start of this article, I mentally assumed that there would be about 400 consistent gets for the CHI_I1 index – for every Start of the INDEX UNIQUE SCAN operation, I expected the index root block and the index leaf block to count as a consistent get, while the above showed that did not happen.  Let’s trace the consistent gets to see why there were only 202 consistent gets and not roughly 400: 

ALTER SESSION SET TRACEFILE_IDENTIFIER='WATCH_CONSISTENT';
ALTER SESSION SET EVENTS '10200 TRACE NAME CONTEXT FOREVER, LEVEL 1';

SELECT /*+ GATHER_PLAN_STATISTICS LEADING(T1) USE_NL(T2) INDEX(T1) INDEX(T2) */
  T1.ID,
  T1.N1,
  T2.ID,
  T2.N1
FROM
  T1,
  T2
WHERE
  T1.ID=T2.ID
  AND T1.ID BETWEEN 1 AND 200
  AND T2.N1 = 0; 

If we then process the resulting 10200 trace file through one of the above trace file parsers, we might see output like what is listed below (the RDBA in hex is listed first, followed by the number of times that block had been accessed by a consistent get to that point in the trace file):

0206e214 1
0206e215 1
01c0000c 1
01c72e14 1
01c72e15 1
01c003ec 1
01c72e14 2
01c72e15 2
01c003ec 2
01c72e15 3
01c003ec 3
01c72e15 4
01c003ec 4
...
01c72e15 56
01c003ec 56
01c72e15 57
01c003ec 57
01c0000d 1
01c72e15 58
01c003ed 1
01c72e15 59
01c003ed 2
01c72e15 60
01c003ed 3
01c72e15 61
...
01c72e15 113
01c003ed 56
01c72e15 114
01c003ed 57
01c0000e 1
01c72e15 115
01c003ee 1
01c72e15 116
01c003ee 2
01c72e15 117
...
01c72e15 170
01c003ee 56
01c72e15 171
01c003ee 57
01c0000f 1
01c72e15 172
01c003ef 1
01c72e15 173
01c003ef 2
01c72e15 174
01c003ef 3
...
01c72d95 199
01c003ef 28
01c72d95 200
01c003ef 29

01c72e15 199
01c003ef 28
01c72e15 200
01c003ef 29

0206e214 1
0206e215 1
01c0000c 1
01c72e14 2
01c72e15 200
01c003ec 57
01c0000d 1
01c003ed 57
01c0000e 1
01c003ee 57
01c0000f 1
01c003ef 29

At the bottom of the output is a summary that shows (in order) RDBA 0206e214 was accessed a total of 1 time, RDBA 0206e215 was accessed 1 time, RDBA 01c0000c was accessed 1 time, RDBA 01c72e14 was accessed 2 times, RDBA 01c72e15 was accessed 200 times, etc.  Nice, but what do those RDBA numbers represent?  We will get to that later.

Inside the raw 10200 trace file we might see something like this (I am able to identifysome items that appear in the raw trace file, but I do not yet fully understand the file):

...
*** SESSION ID:(146.18) 2011-01-23 14:36:18.700
Consistent read started for block 9 : 0206e214
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 9sch: scn: 0x0000.00000000)
CR exa ret 2 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 206e214
Consistent read started for block 9 : 0206e215
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 9 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 206e215
Consistent read finished for block 9 : 206e215
Consistent read started for block 9 : 01c0000c
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 9 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 1c0000c
Consistent read finished for block 9 : 1c0000c
Consistent read started for block 9 : 01c72e14
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 2 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 1c72e14
Consistent read started for block 9 : 01c72e15
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 2 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 1c72e15
Consistent read started for block 9 : 01c003ec
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 2 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 1c003ec
Consistent read started for block 9 : 01c72e14
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 9 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 1c72e14
Consistent read finished for block 9 : 1c72e14
Consistent read started for block 9 : 01c72e15
  env: (scn: 0x0000.00135bfd  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: xid: 0x0000.000.00000000  scn: 0x0000.00000000 10sch: scn: 0x0000.00135bfd)
CR exa ret 2 on:  0000000004B99F38  scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  scn: 0xffff.ffffffff  sfl: 0
Consistent read finished for block 9 : 1c72e15
... 

Now that we see the RDBA numbers again, I suppose that it is time to try to determine the objects that are referenced by the RDBA numbers.  We can try dumping the index structure to see which blocks are read, but first need to find the OBJECT_IDs for the two indexes:

SELECT
  OBJECT_NAME,
  OBJECT_ID
FROM
  DBA_OBJECTS
WHERE
  OBJECT_NAME IN ('PAR_I1','CHI_I1');

OBJECT_NAME  OBJECT_ID
----------- ----------
CHI_I1           48143
PAR_I1           48142 

With the OBJECT_IDs we are able to write the index structures to a trace file:

ALTER SESSION SET TRACEFILE_IDENTIFIER='TREE_DUMP_CHI_I1';
ALTER SESSION SET EVENTS 'IMMEDIATE TRACE NAME TREEDUMP LEVEL 48143';

ALTER SESSION SET TRACEFILE_IDENTIFIER='TREE_DUMP_PAR_I1';
ALTER SESSION SET EVENTS 'IMMEDIATE TRACE NAME TREEDUMP LEVEL 48142'; 

Partial output from the TREE_DUMP_PAR_I1 trace file might look like the section that follows (items appearing in bold were identified in the trace file summary):

----- begin tree dump
branch: 0x206e214 34005524 (0: nrow: 625, level: 1)
   leaf: 0x206e215 34005525 (-1: nrow: 520 rrow: 520)
   leaf: 0x206e216 34005526 (0: nrow: 513 rrow: 513)
   leaf: 0x206e217 34005527 (1: nrow: 513 rrow: 513)
   leaf: 0x206e218 34005528 (2: nrow: 513 rrow: 513) 
...
   leaf: 0x206ee0e 34008590 (623: nrow: 435 rrow: 435)
----- end tree dump

In the above 0x206e214 is a branch block (actually the root block) and 0x206e215 is the first leaf block.

Partial output from the TREE_DUMP_CHI_I1 trace file might look like the section that follows (items appearing in bold were identified in the trace file summary):

----- begin tree dump
branch: 0x1c72e14 29830676 (0: nrow: 625, level: 1)
   leaf: 0x1c72e15 29830677 (-1: nrow: 520 rrow: 520)
   leaf: 0x1c72e16 29830678 (0: nrow: 513 rrow: 513)
   leaf: 0x1c72e17 29830679 (1: nrow: 513 rrow: 513)
   leaf: 0x1c72e18 29830680 (2: nrow: 513 rrow: 513)
...
   leaf: 0x1c7308e 29831310 (623: nrow: 435 rrow: 435)
----- end tree dump 

In the above, 0x1c72e14 is a branch block (actually the root block) and 0x1c72e15 is the first leaf block.

If we take another look at the summary, we are now able to update the summary with the index block information:

0206e214 1     /* PAR_I1 Root block of index on T1 */
0206e215 1     /* PAR_I1 Leaf block of index on T1 */
01c0000c 1
01c72e14 2     /* CHI_I1 Root block of index on T2 */
01c72e15 200   /* CHI_I1 Leaf block of index on T2 */
01c003ec 57
01c0000d 1
01c003ed 57
01c0000e 1
01c003ee 57
01c0000f 1
01c003ef 29 

Let’s try to find the source of the rest of the blocks that were found in the summary (I guess that this could be the hard way to get the job done):

SELECT
  SEGMENT_NAME,
  HEADER_FILE,
  HEADER_BLOCK,
  BLOCKS,
  HEADER_BLOCK+BLOCKS-1 MAX_BLOCKS
FROM
  DBA_SEGMENTS
WHERE
  SEGMENT_NAME IN ('T1','T2');

SEGMENT_NAME HEADER_FILE HEADER_BLOCK     BLOCKS MAX_BLOCKS
------------ ----------- ------------ ---------- ----------
T1                     7           11       5504       5514
T2                     7         1003       5504       6506 

Taking the above HEADER_FILE, HEADER_BLOCK, and MAX_BLOCKS numbers and dumping the block contents to a trace file (this will work in this test case script because all of the extents for the table blocks are probably close to each other – looking back, it probably would have been a better idea to use DBA_EXTENTS rather than DBA_SEGMENTS and just dump the first extent for each object):

ALTER SESSION SET TRACEFILE_IDENTIFIER='TABLE_DUMP_T1';
ALTER SYSTEM DUMP DATAFILE 7 BLOCK MIN 11 BLOCK MAX 5514;

ALTER SESSION SET TRACEFILE_IDENTIFIER='TABLE_DUMP_T2';
ALTER SYSTEM DUMP DATAFILE 7 BLOCK MIN 1003 BLOCK MAX 6506; 

Partial output from the TABLE_DUMP_T1 trace file might look like the following (items appearing in bold were identified in the trace file summary):

   Second Level Bitmap block DBAs
   --------------------------------------------------------
   DBA 1:   0x01c0000a

buffer tsn: 9 rdba: 0x01c0000c (7/12)
scn: 0x0000.00135a07 seq: 0x02 flg: 0x04 tail: 0x5a070602
frmt: 0x02 chkval: 0x541c type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c0000d (7/13)
scn: 0x0000.00135a07 seq: 0x02 flg: 0x04 tail: 0x5a070602
frmt: 0x02 chkval: 0x42da type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c0000e (7/14)
scn: 0x0000.00135a07 seq: 0x02 flg: 0x04 tail: 0x5a070602
frmt: 0x02 chkval: 0x840f type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c0000f (7/15)
scn: 0x0000.00135a07 seq: 0x02 flg: 0x04 tail: 0x5a070602
frmt: 0x02 chkval: 0x74ce type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
... 

Partial output from the TABLE_DUMP_T1 TABLE_DUMP_T2 trace file might look like the following (items appearing in bold were identified in the trace file summary):

   Second Level Bitmap block DBAs
   --------------------------------------------------------
   DBA 1:   0x01c003ea

buffer tsn: 9 rdba: 0x01c003ec (7/1004)
scn: 0x0000.00135ac4 seq: 0x02 flg: 0x04 tail: 0x5ac40602
frmt: 0x02 chkval: 0x50a8 type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c003ed (7/1005)
scn: 0x0000.00135ac4 seq: 0x02 flg: 0x04 tail: 0x5ac40602
frmt: 0x02 chkval: 0x2ef2 type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c003ee (7/1006)
scn: 0x0000.00135ac4 seq: 0x02 flg: 0x04 tail: 0x5ac40602
frmt: 0x02 chkval: 0xbc00 type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c003ef (7/1007)
scn: 0x0000.00135ac4 seq: 0x02 flg: 0x04 tail: 0x5ac40602
frmt: 0x02 chkval: 0x6c98 type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
...
buffer tsn: 9 rdba: 0x01c003f0 (7/1008)
scn: 0x0000.00135ac4 seq: 0x02 flg: 0x04 tail: 0x5ac40602
frmt: 0x02 chkval: 0xf228 type: 0x06=trans data
Hex dump of block: st=0, typ_found=1
Dump of memory from 0x00000000080F4400 to 0x00000000080F6400
... 

Taking another look at the summary, now updated with the table blocks:

0206e214 1     /* PAR_I1 Root block of index on T1 */
0206e215 1     /* PAR_I1 Leaf block of index on T1 */
01c0000c 1     /* T1     Table block */
01c72e14 2     /* CHI_I1 Root block of index on T2 */
01c72e15 200   /* CHI_I1 Leaf block of index on T2 */
01c003ec 57    /* T2     Table block */
01c0000d 1     /* T1     Table block */
01c003ed 57    /* T2     Table block */
01c0000e 1     /* T1     Table block */
01c003ee 57    /* T2     Table block */
01c0000f 1     /* T1     Table block */
01c003ef 29    /* T2     Table block */

Those datafile dumps can be quite time consuming, is there anything else we can try?

We could try to find the RDBA for the ten blocks (note that there is a risk here if the first extent is only eight blocks in length) in the first extent of each segment using the DBMS_UTILITY.MAKE_DATA_BLOCK_ADDRESS function (items appearing in bold were identified in the trace file summary):

SELECT
  SEGMENT_NAME,
  DBMS_UTILITY.MAKE_DATA_BLOCK_ADDRESS(HEADER_FILE,HEADER_BLOCK+RN) RDBA,
  TO_CHAR(DBMS_UTILITY.MAKE_DATA_BLOCK_ADDRESS(HEADER_FILE,HEADER_BLOCK+RN),'XXXXXXXXXX') HEX_RDBA
FROM
  DBA_SEGMENTS,
  (SELECT /*+ MATERIALIZE */
    ROWNUM-1 RN
  FROM
    DUAL
  CONNECT BY
    LEVEL<=10)
WHERE
  SEGMENT_NAME IN ('T1','T2')
ORDER BY
  SEGMENT_NAME,
  RN;

SEGMENT_NAME       RDBA HEX_RDBA
------------ ---------- -----------
T1             29360139     1C0000B
T1             29360140     1C0000C
T1             29360141     1C0000D
T1             29360142     1C0000E
T1             29360143     1C0000F
T1             29360144     1C00010
T1             29360145     1C00011
T1             29360146     1C00012
T1             29360147     1C00013
T1             29360148     1C00014
T2             29361131     1C003EB
T2             29361132     1C003EC
T2             29361133     1C003ED
T2             29361134     1C003EE
T2             29361135     1C003EF
T2             29361136     1C003F0
T2             29361137     1C003F1
T2             29361138     1C003F2
T2             29361139     1C003F3
T2             29361140     1C003F4 

Or, we could try working from the opposite direction.  With the knowledge that the lower 22 bits of the RDBA is the block number and the upper ten bits of the RDBA is the relative file number, we can manually calculate the relative file number and the block number from the RDBA and then look up the object name associated with the file and block.  First, we need the decimal equivalent of  (binary) 1111111111111111111111:

(binary) 1111111111111111111111 = (decimal) 4194303 

So, if we BITAND the RDBA with 4194303 we can obtain the block number, and if we divide the RDBA by 4194304 we can determine the relative file number for two of the RDBA numbers that were listed in the trace file summary, as shown below:

SELECT
  TO_CHAR(L.RDBA,'XXXXXXXX') HEX_RDBA,
  L.RDBA,
  TRUNC(L.RDBA/4194304) DATA_FILE,
  BITAND(L.RDBA,4194303) DATA_BLOCK
FROM
  (SELECT
    TO_NUMBER('01c0000c', 'XXXXXXXX') RDBA
  FROM
    DUAL
  UNION ALL
  SELECT
    TO_NUMBER('01c003ec', 'XXXXXXXX') RDBA
  FROM
    DUAL) L;

HEX_RDBA        RDBA  DATA_FILE DATA_BLOCK
--------- ---------- ---------- ----------
  1C0000C   29360140          7         12
  1C003EC   29361132          7       1004 

Remembering the number 4194303 might be challenging, so we can just use the DBMS_UTILITY.DATA_BLOCK_ADDRESS_FILE and DBMS_UTILITY.DATA_BLOCK_ADDRESS_BLOCK functions instead.  Looking up the associated object names can be slow, unless we are able to limit the object names to a list of specific objects (ideally, we would also specify the DE.OWNER column in the WHERE clause):

SELECT /*+ LEADING(L) */
  TO_CHAR(L.RDBA, 'XXXXXXXX') RDBA_HEX,
  L.RDBA,
  DE.SEGMENT_NAME,
  DBMS_UTILITY.DATA_BLOCK_ADDRESS_FILE(L.RDBA) DATA_FILE,
  DBMS_UTILITY.DATA_BLOCK_ADDRESS_BLOCK(L.RDBA) DATA_BLOCK
FROM
  (SELECT
    TO_NUMBER('01c0000c', 'XXXXXXXX') RDBA
  FROM
    DUAL
  UNION ALL
  SELECT
    TO_NUMBER('01c003ec', 'XXXXXXXX') RDBA
  FROM
    DUAL) L,
  DBA_EXTENTS DE
WHERE
  DBMS_UTILITY.DATA_BLOCK_ADDRESS_FILE(L.RDBA)=DE.FILE_ID
  AND DBMS_UTILITY.DATA_BLOCK_ADDRESS_BLOCK(L.RDBA) BETWEEN DE.BLOCK_ID AND (DE.BLOCK_ID + DE.BLOCKS - 1)
  AND DE.SEGMENT_NAME IN ('T1','T2')
ORDER BY
  DE.SEGMENT_NAME;

RDBA_HEX        RDBA SEGMENT_NAME  DATA_FILE DATA_BLOCK
--------- ---------- ------------ ---------- ----------
  1C0000C   29360140 T1                    7         12
  1C003EC   29361132 T2                    7       1004  

————————————————-

Now let’s take a look at Oracle Database 11.2.0.2 – what has changed?  If we execute the test SQL statement, we see the following execution plan for the query:

SELECT * FROM TABLE(DBMS_XPLAN.DISPLAY_CURSOR(NULL,NULL,'ALLSTATS LAST -ROWS -PREDICATE'));

SQL_ID  1afa5ym56cagh, child number 0
-------------------------------------
SELECT /*+ GATHER_PLAN_STATISTICS LEADING(T1) USE_NL(T2) INDEX(T1)
INDEX(T2) */   T1.ID,   T1.N1,   T2.ID,   T2.N1 FROM   T1,   T2 WHERE
T1.ID=T2.ID   AND T1.ID BETWEEN 1 AND 200   AND T2.N1 = 0

Plan hash value: 3072046012

----------------------------------------------------------------------------------------
| Id  | Operation                    | Name   | Starts | A-Rows |   A-Time   | Buffers |
----------------------------------------------------------------------------------------
|   0 | SELECT STATEMENT             |        |      1 |      0 |00:00:00.01 |     215 |
|   1 |  NESTED LOOPS                |        |      1 |      0 |00:00:00.01 |     215 |
|   2 |   TABLE ACCESS BY INDEX ROWID| T1     |      1 |    200 |00:00:00.01 |       6 |
|   3 |    INDEX RANGE SCAN          | PAR_I1 |      1 |    200 |00:00:00.01 |       2 |
|   4 |   TABLE ACCESS BY INDEX ROWID| T2     |    200 |      0 |00:00:00.01 |     209 |
|   5 |    INDEX UNIQUE SCAN         | CHI_I1 |    200 |    200 |00:00:00.01 |       9 |
---------------------------------------------------------------------------------------- 

Notice in the above that the 202 consistent gets that we saw for the CHI_I1 index in Oracle Database 10.2.0.5 oddly only required 9 consistent gets in Oracle Database 11.2.0.2.  But that is not the only change.  If we process the 10200 trace file through one of the trace file parsers, we might see something like this:

0x0200439b> objd: 0x00011711 1
0x0200439c> objd: 0x00011711 1
0x02000083> objd: 0x00011705 1
0x01c04d9b> objd: 0x00011710 1
0x01c04d9c> objd: 0x00011710 1
0x01c0389b> objd: 0x00011706 1
0x01c04d9b> objd: 0x00011710 2
0x01c04d9c> objd: 0x00011710 2
0x01c0389b> objd: 0x00011706 2
0x01c04d9c> objd: 0x00011710 3
0x01c0389b> objd: 0x00011706 3
0x01c04d9c> objd: 0x00011710 4
0x01c0389b> objd: 0x00011706 4
0x01c04d9c> objd: 0x00011710 5
0x01c0389b> objd: 0x00011706 5
0x01c04d9c> objd: 0x00011710 6
0x01c0389b> objd: 0x00011706 6
0x01c04d9c> objd: 0x00011710 7
0x01c0389b> objd: 0x00011706 7
0x01c0389b> objd: 0x00011706 8
0x01c0389b> objd: 0x00011706 9
0x01c0389b> objd: 0x00011706 10
0x01c0389b> objd: 0x00011706 11
0x01c0389b> objd: 0x00011706 12  
...
0x01c0389b> objd: 0x00011706 54
0x01c0389b> objd: 0x00011706 55
0x01c0389b> objd: 0x00011706 56
0x01c0389b> objd: 0x00011706 57
0x02000084> objd: 0x00011705 1
0x01c0389c> objd: 0x00011706 1
0x01c0389c> objd: 0x00011706 2
0x01c0389c> objd: 0x00011706 3
0x01c0389c> objd: 0x00011706 4
...
0x01c0389c> objd: 0x00011706 55
0x01c0389c> objd: 0x00011706 56
0x01c0389c> objd: 0x00011706 57
0x02000085> objd: 0x00011705 1
0x01c0389d> objd: 0x00011706 1
0x01c0389d> objd: 0x00011706 2
0x01c0389d> objd: 0x00011706 3
0x01c0389d> objd: 0x00011706 4
0x01c0389d> objd: 0x00011706 5
...
0x01c0389d> objd: 0x00011706 55
0x01c0389d> objd: 0x00011706 56
0x01c0389d> objd: 0x00011706 57
0x02000086> objd: 0x00011705 1
0x01c0389e> objd: 0x00011706 1
0x01c0389e> objd: 0x00011706 2
0x01c0389e> objd: 0x00011706 3
...
0x01c0389e> objd: 0x00011706 27
0x01c0389e> objd: 0x00011706 28
0x01c0389e> objd: 0x00011706 29

0x0200439b> objd: 0x00011711 1
0x0200439c> objd: 0x00011711 1
0x02000083> objd: 0x00011705 1
0x01c04d9b> objd: 0x00011710 2
0x01c04d9c> objd: 0x00011710 7
0x01c0389b> objd: 0x00011706 57
0x02000084> objd: 0x00011705 1
0x01c0389c> objd: 0x00011706 57
0x02000085> objd: 0x00011705 1
0x01c0389d> objd: 0x00011706 57
0x02000086> objd: 0x00011705 1
0x01c0389e> objd: 0x00011706 29

Interesting – it appears that Oracle Database 11.2.0.2 writes the DATA_OBJECT_ID that is related to the block, directly into the trace file so that we no longer need to execute several SQL statements to determine the object names related to the blocks.

Inside the raw 10200 trace file from 11.2.0.2 we might see something like the following:

ktrgtc2(): started for block <0x0009 : 0x0200439b> objd: 0x00011711
  env [0x000000001870BF5C]: (scn: 0x0000.0014c547  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: 0x0000.000.00000000  st-scn: 0x0000.00000000  hi-scn: 0x0000.00000000  ma-scn: 0x0000.0014c527  flg: 0x00000661)
ktrexc(): returning 2 on:  0000000013C3D598  cr-scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  cl-scn: 0xffff.ffffffff  sfl: 0
ktrgtc2(): completed for block <0x0009 : 0x0200439b> objd: 0x00011711
ktrget2(): started for block  <0x0009 : 0x0200439c> objd: 0x00011711
env [0x000000001870BF5C]: (scn: 0x0000.0014c547  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: 0x0000.000.00000000  st-scn: 0x0000.00000000  hi-scn: 0x0000.0014c547  ma-scn: 0x0000.0014c527  flg: 0x00000662)
ktrexf(): returning 9 on:  0000000013C3D598  cr-scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  cl-scn: 0xffff.ffffffff  sfl: 0
ktrgcm(): completed for block  <0x0009 : 0x0200439c> objd: 0x00011711
ktrget2(): completed for  block <0x0009 : 0x0200439c> objd: 0x00011711
ktrget2(): started for block  <0x0009 : 0x02000083> objd: 0x00011705
env [0x000000001870BF5C]: (scn: 0x0000.0014c547  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: 0x0000.000.00000000  st-scn: 0x0000.00000000  hi-scn: 0x0000.0014c547  ma-scn: 0x0000.0014c527  flg: 0x00000662)
ktrexf(): returning 9 on:  0000000013C3D598  cr-scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  cl-scn: 0xffff.ffffffff  sfl: 0
ktrgcm(): completed for block  <0x0009 : 0x02000083> objd: 0x00011705
ktrget2(): completed for  block <0x0009 : 0x02000083> objd: 0x00011705
ktrgtc2(): started for block <0x0009 : 0x01c04d9b> objd: 0x00011710
  env [0x000000001870BF5C]: (scn: 0x0000.0014c547  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: 0x0000.000.00000000  st-scn: 0x0000.00000000  hi-scn: 0x0000.0014c547  ma-scn: 0x0000.0014c527  flg: 0x00000662)
ktrexc(): returning 2 on:  0000000013C3D598  cr-scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  cl-scn: 0xffff.ffffffff  sfl: 0
ktrgtc2(): completed for block <0x0009 : 0x01c04d9b> objd: 0x00011710
ktrgtc2(): started for block <0x0009 : 0x01c04d9c> objd: 0x00011710
  env [0x000000001870BF5C]: (scn: 0x0000.0014c547  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  statement num=0  parent xid: 0x0000.000.00000000  st-scn: 0x0000.00000000  hi-scn: 0x0000.0014c547  ma-scn: 0x0000.0014c527  flg: 0x00000662)
ktrexc(): returning 2 on:  0000000013C3D598  cr-scn: 0xffff.ffffffff  xid: 0x0000.000.00000000  uba: 0x00000000.0000.00  cl-scn: 0xffff.ffffffff  sfl: 0
ktrgtc2(): completed for block <0x0009 : 0x01c04d9c> objd: 0x00011710  

The 10200 trace file in 11.2.0.2 provided the DATA_OBJECT_ID for the consistent reads, while the 10.2.0.5 trace file did not.  We can use this information to determine which objects were accessed, and in which order by pulling in the unique OBJD values from the summary:

SELECT
  OBJECT_NAME,
  DATA_OBJECT_ID,
  TO_CHAR(DATA_OBJECT_ID, 'XXXXX') HEX_DATA_OBJECT_ID
FROM
  DBA_OBJECTS
WHERE
  DATA_OBJECT_ID IN(
    TO_NUMBER('11711', 'XXXXX'),
    TO_NUMBER('11705', 'XXXXX'),
    TO_NUMBER('11710', 'XXXXX'),
    TO_NUMBER('11706', 'XXXXX'));

OBJECT_NAME DATA_OBJECT_ID HEX_DA
----------- -------------- ------
T1                   71429  11705
T2                   71430  11706
CHI_I1               71440  11710
PAR_I1               71441  11711 

Taking another look at the summary, now updated with the table and index blocks:

0x0200439b> objd: 0x00011711 1   /* PAR_I1 Root block of index on T1 */
0x0200439c> objd: 0x00011711 1   /* PAR_I1 Leaf block of index on T1 */
0x02000083> objd: 0x00011705 1   /* T1     Table block */
0x01c04d9b> objd: 0x00011710 2   /* CHI_I1 Root block of index on T2 */
0x01c04d9c> objd: 0x00011710 7   /* CHI_I1 Leaf block of index on T2 */
0x01c0389b> objd: 0x00011706 57  /* T2     Table block */
0x02000084> objd: 0x00011705 1   /* T1     Table block */
0x01c0389c> objd: 0x00011706 57  /* T2     Table block */
0x02000085> objd: 0x00011705 1   /* T1     Table block */
0x01c0389d> objd: 0x00011706 57  /* T2     Table block */
0x02000086> objd: 0x00011705 1   /* T1     Table block */
0x01c0389e> objd: 0x00011706 2   /* T2     Table block */ 

So, from the above, 2 of the consistent gets for the CHI_I1 index were for the root block of the index, and the remaining 7 were for the first leaf block.

Simple?

——————-

Anyone want to try creating a 10200 trace file parser in a different programming language and posting the source code here?





MS Query Teases You – Excel will Not Display Text Contained in Long Raw/Blob Column

30 10 2010

October 30, 2010

Older versions of the ERP package that I work with stored lengthy text data in LONG RAW columns.  Newer versions of the ERP package store lengthy text data in BLOB columns.  When tables containing those columns are queried using the Microsoft Query tool, which allows the data stored in tables to be retrieved into an Excel worksheet, the text found within the LONG RAW and BLOB columns appears in the Microsoft Query preview window, but those columns are silently excluded when the data is brought back into Microsoft Excel.  There must be a work around.  Sure, there is an easy solution for BLOB columns using a combination of the UTL_RAW.CAST_TO_VARCHAR2 and DBMS_LOB.SUBSTR functions, but is there a solution for LONG RAW columns?

First, we will build a table to somewhat mimic a table found in the old version of the ERP package (I think that I only omitted the WORKORDER_SUB_ID column):

CREATE TABLE T5(
  WORKORDER_TYPE CHAR(1),
  WORKORDER_BASE_ID VARCHAR2(30),
  WORKORDER_LOT_ID VARCHAR2(3),
  WORKORDER_SPLIT_ID VARCHAR2(3),
  SEQUENCE_NO NUMBER(12,0),
  TYPE CHAR(1),
  BITS_LENGTH NUMBER(12,0),
  BITS LONG RAW);

Now, let’s build a bit of code using the Visual Basic for Applications macro editor in Excel to populate the table.  I will use late binding, like what is required in VBS macros, so that I can use ADO without adding ADO references in the Visual Basic editor (see the previous articles in the Excel category for directions that permit early binding).

Const adCmdText = 1
Const adCmdStoredProc = 4
Const adParamInput = 1
Const adVarNumeric = 139
Const adBigInt = 20
Const adDecimal = 14
Const adDouble = 5
Const adInteger = 3
Const adLongVarBinary = 205
Const adNumeric = 131
Const adSingle = 4
Const adSmallInt = 2
Const adTinyInt = 16
Const adUnsignedBigInt = 21
Const adUnsignedInt = 19
Const adUnsignedSmallInt = 18
Const adUnsignedTinyInt = 17
Const adDate = 7
Const adDBDate = 133
Const adDBTimeStamp = 135
Const adDBTime = 134
Const adVarChar = 200
Const adUseClient = 3
Const adOpenKeyset = 1
Const adLockOptimistic = 3

Sub CreateRows()
    Dim i As Integer

    Dim strUsername As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim strSQL As String

    Dim intLength As Integer
    Dim strTempBits As String
    Dim bytBits() As Byte                         'An array of bytes

    Dim dynData As Object                         'ADO Recordset object used to retrieve the user's data
    Dim dbDatabase As Object                      'ADO database connection object

    On Error Resume Next

    Set dynData = CreateObject("ADODB.Recordset")
    Set dbDatabase = CreateObject("ADODB.Connection")

    strDatabase = "MyDB"
    strUsername = "MyUser"
    strPassword = "MyPassword"

    'Connect to the database
    'Oracle connection string
    dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

    dbDatabase.ConnectionTimeout = 40
    dbDatabase.CursorLocation = adUseClient
    dbDatabase.Open

    'Retrieve a recordset with 0 rows that will allow us to insert into the table
    strSQL = "SELECT"
    strSQL = strSQL & "  WORKORDER_TYPE," & vbCrLf
    strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  WORKORDER_SPLIT_ID," & vbCrLf
    strSQL = strSQL & "  SEQUENCE_NO," & vbCrLf
    strSQL = strSQL & "  TYPE," & vbCrLf
    strSQL = strSQL & "  BITS_LENGTH," & vbCrLf
    strSQL = strSQL & "  BITS" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  T5" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  1=2"
    dynData.Open strSQL, dbDatabase, adOpenKeyset, adLockOptimistic, adCmdText

    For i = 1 To 1000
        dynData.AddNew
        dynData("workorder_type") = "W"
        dynData("workorder_base_id") = "WO" & String(6 - Len(Format(i)), "0") & Format(i)
        dynData("workorder_lot_id") = "1"
        dynData("workorder_split_id") = "0"
        dynData("sequence_no") = 10
        dynData("type") = "D"

        strTempBits = "WO" & String(6 - Len(Format(i)), "0") & Format(i) & "/" & "1" & "  This is a very long description." & String(1000, ".")
        bytBits = StrConv(strTempBits, vbFromUnicode)
        intLength = Len(strTempBits)

        dynData("bits_length") = intLength
        dynData.Fields("bits").AppendChunk bytBits

        dynData.Update
    Next i

    dynData.Close
    dbDatabase.Close

    Set dynData = Nothing
    Set dbDatabase = Nothing
End Sub

When the above code is executed, the test table T5 should contain 1,000 rows.  Now let’s see if we are able to retrieve the rows from the database into Excel’s worksheet.  We will start out by switching to the Data tab in Excel (2010) and then select From Microsoft Query:

The next step is to select a suitable (32 bit, even on 64 bit computers) ODBC entry for the database.

Now let’s enter a simple SQL statement to retrieve the data contained in the test table T5 – note that Microsoft Query will complain if the ; character is included at the end of the SQL statement, but this is done to try to keep Microsoft Query from attempting to re-write the SQL statement (this occasionally eliminates a couple of problems):

As you can see, the Microsoft Query preview window shows the text data that is contained within the LONG RAW BITS column as we had hoped:

Now if we tell Microsoft Query to return the rows to Excel, we see that the LONG RAW BITS column was thrown away:

No problem, we will just try a trick to convert the LONG RAW column to a BLOB using the TO_LOB function and then convert the resulting BLOB to a VARCHAR2.  However, that trick simply does not work because the TO_LOB function can only be used in a INSERT INTO SELECT, or CREATE TABLEAS SELECT type SQL statement according to the documentation:

So, let’s create a new table to allow us to temporarily convert the LONG RAW column to a BLOB column:

Now, back in Microsoft Query, we change the SQL statement as follows:

SELECT
  WORKORDER_TYPE,
  WORKORDER_BASE_ID,
  WORKORDER_LOT_ID,
  WORKORDER_SPLIT_ID,
  SEQUENCE_NO,
  TYPE,
  BITS_LENGTH,
  UTL_RAW.CAST_TO_VARCHAR2(DBMS_LOB.SUBSTR(BITS,32000,1)) BITS
FROM
  T5_TEMP
WHERE
  TYPE='D';

When we return the query results into Excel this time, the LONG RAW column that was converted to a BLOB column in the second table, has its column values converted to a VARCHAR2, and those values actually makes it into Excel (although the column alias “BITS” is lost):

But, I don’t want to go through the process of creating a table to temporarily hold the results of a LONG RAW to BLOB conversion so that I can display the characters in Excel – that would be far too messy if there were many tables.  If we tell Excel to record a macro while we bring in data using the Microsoft Query tool, we see a macro that looks like this:

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
    "ODBC;DSN=MyODBC;UID=MyUser;;DBQ=MyDB;DBA=W;APA=T;EXC=F;FEN=T;QTO=F;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;NUM=NL" _
    ), Array("S;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;")), _
    Destination:=Range("$A$1")).QueryTable
    .CommandText = Array( _
    "SELECT" & Chr(13) & "" & Chr(10) & "  WORKORDER_TYPE," & Chr(13) & "" & Chr(10) & "  WORKORDER_BASE_ID," & Chr(13) & "" & Chr(10) & _
       "  WORKORDER_LOT_ID," & Chr(13) & "" & Chr(10) & "  WORKORDER_SPLIT_ID," & Chr(13) & "" & Chr(10) & "  SEQUENCE_NO," & _
       Chr(13) & "" & Chr(10) & "  TYPE," & Chr(13) & "" & Chr(10) & "  BITS_LENGTH," & Chr(13) & "" & Chr(10) & _
       "  UTL_RAW.CAST_TO_VARCHAR2(DBMS_LOB.SUBSTR(BITS,32000,1)) " & Chr(13) & "" & Chr(10) & "FROM" & Chr(13) & "" & Chr(10) & "" _
       , "  T5_TEMP" & Chr(13) & "" & Chr(10) & "WHERE" & Chr(13) & "" & Chr(10) & "  TYPE='D';")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "Table_Query_from_OR1125"
    .Refresh BackgroundQuery:=False
End With

While the above is interesting (and probably explains why the BITS column alias was lost), it is probably of little help for our problem.  We need something better, our own macro, something like the following (note that the following macro writes the data to a text file, and then uses an Excel function to quickly bring that text file into an Excel worksheet.  This approach should be much faster than visiting each cell in the worksheet to write the query results to each cell).

Sub DisplayData()
    Dim i As Integer
    Dim lngRow As Long
    Dim intFileNum As Integer

    Dim strUsername As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim strSQL As String
    Dim strOut As String

    Dim intLength As Integer
    Dim strTempBits As String

    Dim snpData As Object                         'ADO Recordset object used to retrieve the user's data
    Dim dbDatabase As Object                      'ADO database connection object
    On Error Resume Next

    Set snpData = CreateObject("ADODB.Recordset")
    Set dbDatabase = CreateObject("ADODB.Connection")

    strDatabase = "MyDB"
    strUsername = "MyUser"
    strPassword = "MyPassword"

    'Connect to the database
    'Oracle connection string
    dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

    dbDatabase.ConnectionTimeout = 40
    dbDatabase.CursorLocation = adUseClient
    dbDatabase.Open

    'Retrieve a recordset with 0 rows that will allow us to insert into the table
    strSQL = "SELECT"
    strSQL = strSQL & "  WORKORDER_TYPE," & vbCrLf
    strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  WORKORDER_SPLIT_ID," & vbCrLf
    strSQL = strSQL & "  SEQUENCE_NO," & vbCrLf
    strSQL = strSQL & "  TYPE," & vbCrLf
    strSQL = strSQL & "  BITS_LENGTH," & vbCrLf
    strSQL = strSQL & "  BITS" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  T5" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  TYPE='D'"
    snpData.Open strSQL, dbDatabase

    Application.ScreenUpdating = False
    lngRow = 1

    intFileNum = FreeFile
    Open "C:\LongRawToVarchar.txt" For Output As #intFileNum

    strOut = ""
    For i = 0 To snpData.Fields.Count - 1
        strOut = strOut & snpData.Fields(i).Name & vbTab
        'ActiveSheet.Cells(lngRow, i + 1).Value = snpData.Fields(i).Name
    Next i
    Print #intFileNum, strOut

    Do While Not snpData.EOF
        lngRow = lngRow + 1
        strOut = ""
        For i = 0 To snpData.Fields.Count - 2 'All Except the last column
            If Not (IsNull(snpData.Fields(i).Value)) Then
                'Switch out Ascii 13 & Ascii 10 combinations for just Ascii 10 so that line breaks do not cause problems in the resulting file
                strOut = strOut & Replace(snpData.Fields(i).Value, vbCrLf, vbLf) & vbTab
                'ActiveSheet.Cells(lngRow, i + 1).Value = snpData.Fields(i).Value
            Else
                strOut = strOut & vbTab
            End If
        Next i

        'Handle the LONG RAW column
        strTempBits = Replace(StrConv(snpData("bits"), vbUnicode), vbCrLf, vbLf)
        strOut = strOut & strTempBits & vbTab
        'ActiveSheet.Cells(lngRow, snpData.Fields.Count).Value = strTempBits

        Print #intFileNum, strOut

        snpData.MoveNext
    Loop
    snpData.Close

    'Close the data file
    Close #intFileNum

    'Read the text file just written to disk into the worksheet
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\LongRawToVarchar.txt", Destination:=ActiveSheet.Range("A1"))
        .Name = "Page1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True                         'Tabs are the delimiter
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .Refresh BackgroundQuery:=False
    End With

    Application.ScreenUpdating = True

    dbDatabase.Close

    Set snpData = Nothing
    Set dbDatabase = Nothing
End Sub

If we did not want to write the data out to a text file, we could just comment out the section titled as “‘Read the text file just written to disk into the worksheet“, comment out the Print# lines, and uncomment the lines that begin with “‘ActiveSheet.Cells(“.

For example, if we do not want to write the results to a temp file, our macro would look like this:

Sub DisplayData2()
    Dim i As Integer
    Dim lngRow As Long

    Dim strUsername As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim strSQL As String
    Dim strOut As String

    Dim intLength As Integer
    Dim strTempBits As String

    Dim snpData As Object                         'ADO Recordset object used to retrieve the user's data
    Dim dbDatabase As Object                      'ADO database connection object

    On Error Resume Next

    Set snpData = CreateObject("ADODB.Recordset")
    Set dbDatabase = CreateObject("ADODB.Connection")

    strDatabase = "MyDB"
    strUsername = "MyUser"
    strPassword = "MyPassword"

    'Connect to the database
    'Oracle connection string
    dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

    dbDatabase.ConnectionTimeout = 40
    dbDatabase.CursorLocation = adUseClient
    dbDatabase.Open

    'Retrieve a recordset with 0 rows that will allow us to insert into the table
    strSQL = "SELECT"
    strSQL = strSQL & "  WORKORDER_TYPE," & vbCrLf
    strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  WORKORDER_SPLIT_ID," & vbCrLf
    strSQL = strSQL & "  SEQUENCE_NO," & vbCrLf
    strSQL = strSQL & "  TYPE," & vbCrLf
    strSQL = strSQL & "  BITS_LENGTH," & vbCrLf
    strSQL = strSQL & "  BITS" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  T5" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  TYPE='D'"
    snpData.Open strSQL, dbDatabase

    Application.ScreenUpdating = False
    lngRow = 1

    strOut = ""
    For i = 0 To snpData.Fields.Count - 1
        ActiveSheet.Cells(lngRow, i + 1).Value = snpData.Fields(i).Name
    Next i

    Do While Not snpData.EOF
        lngRow = lngRow + 1
        strOut = ""
        For i = 0 To snpData.Fields.Count - 2 'All Except the last column
            If Not (IsNull(snpData.Fields(i).Value)) Then
                'Switch out Ascii 13 & Ascii 10 combinations for just Ascii 10 so that line breaks do not cause problems in the resulting file
                strOut = strOut & Replace(snpData.Fields(i).Value, vbCrLf, vbLf) & vbTab
                ActiveSheet.Cells(lngRow, i + 1).Value = snpData.Fields(i).Value
            Else
                strOut = strOut & vbTab
            End If
        Next i

        'Handle the LONG RAW column
        strTempBits = Replace(StrConv(snpData("bits"), vbUnicode), vbCrLf, vbLf)
        strOut = strOut & strTempBits & vbTab
        ActiveSheet.Cells(lngRow, snpData.Fields.Count).Value = strTempBits

        snpData.MoveNext
    Loop
    snpData.Close

    Application.ScreenUpdating = True

    dbDatabase.Close

    Set snpData = Nothing
    Set dbDatabase = Nothing
End Sub

The resulting worksheet would then need a bit more clean up than it did when we wrote out the data to a text file and brought the text file into the worksheet with a QueryTable:

So, now you know how to retrieve text contained in a LONG RAW column (our T5 table) or text contained in a BLOB column (our T5_TEMP table, as stored by the recent releases of the ERP package) and display the text in an Excel worksheet with other columns retrieved by a query.

I fully recognize that LONG RAW columns are deprecated, but is anyone able to identify a more direct way to transform a LONG RAW column value into a VARCHAR2 using just a SQL statement with built-in Oracle Database functions, without requiring an intermediate temporary table?





Retrieving the Hidden Oracle Parameters and Saving the Parameter Values in Excel

23 02 2010

February 23, 2010

The are a large number of initialization parameters that configure the behavior of an Oracle database instance, and it seems that the number of hidden parameters (those parameters that begin with _ ) continues to grow with each new Oracle Database release.  In some cases, parameters that were once normal parameters became hidden parameters in later releases (the SPIN_COUNT, and _SPIN_COUNT parameters are one example).  In other cases, the normal parameter defines the minimum requested parameter value and the hidden parameter defines the current value (DB_CACHE_SIZE and __DB_CACHE_SIZE parameters, respectively).

For documentation purposes it might be helpful to permanently record the values of the normal and hidden initialization parameters, and that is the purpose of the VBS script in this article.  The script uses a SQL statement that was originally found here, and then was modified so that the normal and hidden versions of the parameters will sort into adjacent rows when dislayed on screen.  Once the parameter values are written to Excel, the Excel worksheet is automatically saved with the value of the DB_NAME initialization parameter and the current date and time.  When targeting an 11.2.0.1 database, the output might look like the following screen capture:

Unfortunately, we have a slight problem.  The SQL statement in the script must be executed as the SYS user, and if the O7_DICTIONARY_ACCESSIBILITY initialization parameter is set to FALSE (the default starting with Oracle 9.0.1), the normal connection string used in previous scripts will not work (I have not found a way to pass AS SYSDBA when Provider=OraOLEDB.Oracle is specified in the connection string).  If you do not want to set the O7_DICTIONARY_ACCESSIBILITY initialization parameter to TRUE, you will need to create an ODBC connection to the database.

To create an ODBC connection, launch the ODBC Data Source Administrator utility from the Control Panel, and switch to the System DSN tab.  Click Add… then select one of the ODBC providers offered by Oracle Corp (you may need to perform a custom install of the Oracle Client for Oracle’s ODBC client to appear in the list – note that there is a separate 32 bit and 64 bit ODBC Administrator on 64 bit Windows, with the 32 bit version located in the Windows\SysWow64 folder, see this article for more information):

Pick a generic name for the ODBC connection, such as MyODBC (this is the name used in the script) and then enter the database name from the Tnsnames.ora file into the TNS Service Name box (I specified or112) – note that you can change this database name at a later time to point the script at a different database.  Click OK.

The VBS script to extract the normal and hidden parameters follows (modify the script to specify the correct password for the SYS user):

'Version 1.0

Const adCmdText = 1
Const adCmdStoredProc = 4
Const adParamInput = 1
Const adVarNumeric = 139
Const adBigInt = 20
Const adDecimal = 14
Const adDouble = 5
Const adInteger = 3
Const adLongVarBinary = 205
Const adNumeric = 131
Const adSingle = 4
Const adSmallInt = 2
Const adTinyInt = 16
Const adUnsignedBigInt = 21
Const adUnsignedInt = 19
Const adUnsignedSmallInt = 18
Const adUnsignedTinyInt = 17
Const adDate = 7
Const adDBDate = 133
Const adDBTimeStamp = 135
Const adDBTime = 134
Const adVarChar = 200
Const adUseClient = 3

Dim strUsername
Dim strPassword
Dim strDatabase
Dim strSQL                          'SQL statement
Dim objExcel                        'For sending the output to Excel

Dim snpData                         'ADO Recordset object used to retrieve the user's data
Dim dbDatabase                      'ADO database connection object

Dim intTempCount                    'Counter of the number of Excel sheets that have been created

Dim strDBNAME                       'DB_NAME parameter from the database parameters
Dim strLastColumn                   'Column identifier in Excel of the right-most column

Dim i                               'Counter

On Error Resume Next

Set snpData = CreateObject("ADODB.Recordset")
Set dbDatabase = CreateObject("ADODB.Connection")

'Create an Excel connection
Set objExcel = CreateObject("Excel.Application")

'Set up to allow exporting, if requested
objExcel.DisplayAlerts = False
objExcel.Workbooks.Add

strUsername = "sys"    'Must connect as the SYS user
strPassword = "SysPassword"
strDatabase = "MyODBC" 'Must use an ODBC connection if O7_DICTIONARY_ACCESSIBILITY = FALSE

If UCase(strUsername) <> "SYS" Then
  'Can use this for SYS if O7_DICTIONARY_ACCESSIBILITY = TRUE, ODBC connection then not required
  dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & ";"
Else
  'Must use an ODBC connection if O7_DICTIONARY_ACCESSIBILITY = FALSE
  dbDatabase.ConnectionString = "Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & " AS SYSDBA;"
End If

dbDatabase.Open

'Should verify that the connection attempt was successful, but I will leave that for someone else to code
If Err <> 0 Then
  MsgBox "Not Connected, Error: " & Err
Else
  'Adapted from the SQL statement at http://www.jlcomp.demon.co.uk/params.html
  strSQL = "SELECT " & vbCrLf
  strSQL = strSQL & "  UPPER(NAM.KSPPINM) NAME," & vbCrLf
  strSQL = strSQL & "  VAL.KSPPSTVL VALUE," & vbCrLf
  strSQL = strSQL & "  NAM.INDX+1 NUM," & vbCrLf
  strSQL = strSQL & "  NAM.KSPPITY TYPE," & vbCrLf
  strSQL = strSQL & "  VAL.KSPPSTDF ISDEFAULT," & vbCrLf
  strSQL = strSQL & "  DECODE(BITAND(NAM.KSPPIFLG/256,1),1,'TRUE','FALSE') ISSES_MODIFIABLE," & vbCrLf
  strSQL = strSQL & "  DECODE(BITAND(NAM.KSPPIFLG/65536,3)," & vbCrLf
  strSQL = strSQL & "    1,'IMMEDIATE'," & vbCrLf
  strSQL = strSQL & "    2,'DEFERRED' ," & vbCrLf
  strSQL = strSQL & "    3,'IMMEDIATE'," & vbCrLf
  strSQL = strSQL & "    'FALSE') ISSYS_MODIFIABLE," & vbCrLf
  strSQL = strSQL & "  DECODE(BITAND(VAL.KSPPSTVF,7)," & vbCrLf
  strSQL = strSQL & "    1,'MODIFIED'," & vbCrLf
  strSQL = strSQL & "    4,'SYSTEM MODIFIED'," & vbCrLf
  strSQL = strSQL & "    'FALSE') ISMODIFIED," & vbCrLf
  strSQL = strSQL & "  DECODE(BITAND(VAL.KSPPSTVF,2),2,'TRUE', 'FALSE') ISADJUSTED," & vbCrLf
  strSQL = strSQL & "  NAM.KSPPDESC DESCRIPTION" & vbCrLf
  strSQL = strSQL & "FROM" & vbCrLf
  strSQL = strSQL & "  X$KSPPI NAM," & vbCrLf
  strSQL = strSQL & "  X$KSPPSV VAL" & vbCrLf
  strSQL = strSQL & "WHERE " & vbCrLf
  strSQL = strSQL & "  NAM.INDX = VAL.INDX " & vbCrLf
  strSQL = strSQL & "ORDER BY" & vbCrLf
  strSQL = strSQL & "  UPPER(DECODE(SUBSTR(NAM.KSPPINM,1,2),'__',SUBSTR(NAM.KSPPINM,3)," & vbCrLf
  strSQL = strSQL & "          DECODE(SUBSTR(NAM.KSPPINM,1,1),'_',SUBSTR(NAM.KSPPINM,2),NAM.KSPPINM)))," & vbCrLf
  strSQL = strSQL & "  UPPER(NAM.KSPPINM)"
  snpData.Open strSQL, dbDatabase

  If snpData.State = 1 Then
    If Not (snpData.EOF) Then
      With objExcel
        .Visible = True
        .ActiveWorkbook.Sheets.Add
        .ActiveSheet.Name = "DB Parameters"

         For i = 0 To snpData.Fields.Count - 1
           .ActiveSheet.Cells(1, i + 1).Value = snpData.Fields(i).Name
         Next
         .ActiveSheet.Range(.ActiveSheet.Cells(1, 1), .ActiveSheet.Cells(1, snpData.Fields.Count)).Font.Bold = True

         'Format the columns in the spreadsheet
         For i = 0 To snpData.Fields.Count - 1
           strLastColumn = Chr(64 + ((i + 1) Mod 26))

           .Columns(strLastColumn).Select
           Select Case snpData.Fields(i).Type
             Case adDate, adDBDate, adDBTimeStamp, adDBTime
               .Selection.HorizontalAlignment = -4152
               .Selection.NumberFormat = "mm/dd/yy hh:nn AM/PM"
             Case adBigInt, adInteger, adSmallInt, adTinyInt, adUnsignedBigInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt
               .Selection.HorizontalAlignment = -4152
               .Selection.NumberFormat = "0"
             Case adVarNumeric, adDecimal, adDouble, adNumeric, adSingle
               .Selection.HorizontalAlignment = -4152
               .Selection.NumberFormat = "0"
             Case adVarChar
               .Selection.HorizontalAlignment = -4131
               .Selection.NumberFormat = "@"
           End Select
         Next

         strLastColumn = Chr(64 + ((snpData.Fields.Count + 1) Mod 26))
         .ActiveSheet.Range("A2").CopyFromRecordset snpData

         'Auto-fit up to columns
         .ActiveSheet.Columns("A:" & strLastColumn).AutoFit
         .ActiveSheet.Range("B2").Select
         .ActiveWindow.FreezePanes = True

         .Application.DisplayAlerts = False
         'Remove the default worksheets
         For i = 1 To ActiveWorkbook.Sheets.Count
           If .ActiveWorkbook.Sheets(i).Name = "Sheet1" Then
             .Sheets("Sheet1").Select
             .ActiveWindow.SelectedSheets.Delete
           End If
           If .ActiveWorkbook.Sheets(i).Name = "Sheet2" Then
             .Sheets("Sheet2").Select
             .ActiveWindow.SelectedSheets.Delete
           End If
           If .ActiveWorkbook.Sheets(i).Name = "Sheet3" Then
             .Sheets("Sheet3").Select
             .ActiveWindow.SelectedSheets.Delete
           End If
         Next
      End With
      snpData.Close

      'Repeat the SQL statement to find the value of the DB_NAME parameter
      snpData.Open strSQL, dbDatabase

      Do While Not (snpData.EOF)
        If UCase(snpData("name")) = "DB_NAME" Then
          strDBNAME = snpData("value")
          Exit Do
        End If
        snpData.MoveNext
      Loop
    Else
      MsgBox "No Rows Returned"
    End If
  Else
    MsgBox "Could Not Open the SQL Statement " & Err
  End If
  snpData.Close

  objExcel.ActiveWorkbook.SaveAs "C:\OracleParameters " & strDBNAME & " " & Replace(Replace(Now, "/", "-"), ":", "-") & ".xls"
End If

'Clean Up
Set objExcel = Nothing
Set snpData = Nothing
dbDatabase.Close
Set dbDatabase = Nothing

When the script runs it will create a spreadsheet in the root of the C:\ drive – move the spreadsheet as needed for documentation purposes.





Automated DBMS_XPLAN, Trace, and Send to Excel

11 02 2010

February 11, 2010

If you have spent some time looking at the posts on this site you might have seen my Toy Project for performance tuning mentioned in a couple of those posts.  One of the windows in the program allows me to submit a SQL statement to the database and retrieve the execution plan using DBMS_XPLAN while simultaneously generating a 10046, 10053, 10032, or 10033 trace files.  That program window looks like this:

What would it take to implement something like the above using a VBS script with an Internet Explorer browser window acting at the user interface?  It might also be nice to have the ability to send the query results into Excel on demand.  The end result might look something like this (note that the array fetch setting might not have any effect):

If we use the sample tables from this blog post, what is the execution plan for the following SQL statement?

SELECT
  T3.C1 T3_C1,
  SUBSTR(T3.C2,1,10) T3_C2,
  T2.C1 T2_C1,
  SUBSTR(T2.C2,1,10) T2_C2,
  T1.C1 T1_C1,
  SUBSTR(T1.C2,1,10) T1_C2
FROM
  T3,
  T2,
  T1
WHERE
  T1.C1=T3.C1
  AND T1.C1=T2.C1
  AND T1.C1 BETWEEN 1 AND 10

If we submit the SQL statement with the TYPICAL format parameter specified, the following execution plan will appear (note that on Vista and Windows 7, the execution plan may hide behind the main window – a pop-under effect):

The first 100 rows from the SQL statement appear at the bottom of the window.  With the TYPICAL format parameter specified, we are only able to determine the estimated number of rows that will be returned, and the estimated execution time.

If we change the format parameter to ALLSTATS LAST and change the Statistics Level to ALL, we are able to see the actual execution statistics for the plan:

Of course at this point, we might wonder if nested loops joins might be more efficient than hash joins, so we could test the change in execution time with a hinted SQL statement:

Looking closely at the plans, we see that the plan with the hash joins completed in 4.31 seconds, while the plan with the nested loops joins completed in 5.0 seconds.  The cost-based optimizer correctly selected the fastest executing plan for the SQL statement.

We also have the option for enabling several types of trace files and determining what, if any, performance impact we see when various trace files are enabled:

Notice that the program assigned a unique trace filename (displayed on the Status line) so that it is easy to find the trace file for our test execution.

The final option on the web page sends the query results into an Excel workbook – do not close the Excel window until you first close the Internet Explorer window, a new worksheet will be created in the workbook every time the Send to Excel button is clicked:

If you want to experiment with this script, you may download it here: XPlanViewerWithTrace.vbs (version 1.0, save as XPlanViewerWithTrace.vbs).

—————————

Update February 18, 2010:

See the documentation for details of the permissions required to use DBMS_XPLAN.DISPLAY_CURSOR.  See comment #2 for the items that need to be changed in the script in order to connect to your database.





Excel – UserForms with Database Access, Called from VBS

7 02 2010

February 7, 2010

This example shows how to use VBS to call built-in Excel functions, as well as custom developed Excel functions from a VBS file.  Additionally, the VBS code is able to take advantage of an Excel userform that connects to the Oracle database. 

We will start by creating a couple of tables – ideally, we would have more of the application logic and information in each of the database tables, but in this example most of the logic is in Excel.

CREATE TABLE CABINET_BUILDER_WOOD (
  WOOD_TYPE VARCHAR2(30),
  PRIMARY KEY (WOOD_TYPE));

INSERT INTO CABINET_BUILDER_WOOD VALUES ('Birch');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Cedar');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Cherry');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Douglas Fir');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Ebony');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Maple');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Pine');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Poplar');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Red Oak');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Redwood');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('Spruce');
INSERT INTO CABINET_BUILDER_WOOD VALUES ('White Oak');

COMMIT;

CREATE TABLE CABINET_BUILDER_CAB_TYPE (
  CABINET_TYPE VARCHAR2(40),
  PRIMARY KEY (CABINET_TYPE));

INSERT INTO CABINET_BUILDER_CAB_TYPE VALUES ('Base Cabinet Full Depth');
INSERT INTO CABINET_BUILDER_CAB_TYPE VALUES ('Base Cabinet Half Depth');
INSERT INTO CABINET_BUILDER_CAB_TYPE VALUES ('Full Height Base Cabinet');
INSERT INTO CABINET_BUILDER_CAB_TYPE VALUES ('Upper Cabinet');
INSERT INTO CABINET_BUILDER_CAB_TYPE VALUES ('Upper Cabinet Narrow');

COMMIT;

Next, we will start preparing the Excel workbook.  Create a new Excel workbook and save it as C:\ExcelMacroFunctionDemo.xls.  Next, right-click the first worksheet in the workbook and select View Code.  From the Tools menu, select References.  Add a reference to a recent release of the Microsoft ActiveX Data Objects Library, and Microsoft Windows Common Controls 6.0 (hopefully, that version is available on your computer).

From the Tools menu, select Additional Controls.  Place a check next to one of the Microsoft TreeView Controls and then click the OK button.

Next, from the Insert menu, select Module – this is where we will need to add the code so that it may be accessed by the VBS script.  Module1 should appear in the tree structure at the left (officially called the Project Explorer).  Add the following code into the Module1 module (this example is adapted from one that I showed in a presentation to an ERP user’s group, so the contents of some of the functions may seem to be a bit odd):

Option Explicit

'Constants for registry access
Private Const ERROR_SUCCESS = 0&
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

'For FindWindow
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9

'Type declaration for Zebra label printing
Public Type DOC_INFO_1
    pDocName As String
    pOutputFile As String
    pDatatype As String
End Type

'Registry API functions
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

'INI API functions
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'Zebra Printing API functions
Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Public Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Public Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long

'For Find Window and bring to top
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

'Used by the ShowWindowAfterDelay sub
Dim strFindWindowTitle As String
Dim intFindExitExcel As String

Public Function CalculateCombinations(lngNumberElements As Long, lngNumberPositions) As Double
    'Calculate the number of possible arrangements where the order does not matter of the number of elements into the number of positions
    CalculateCombinations = Application.WorksheetFunction.Combin(lngNumberElements, lngNumberPositions)
End Function

Public Function CalculateInterestPayment(dblInterestRate As Single, lngPaymentsPerYear As Long, lngNumPayments As Long, sglCurrentValue As Single) As Single
    'Calculates the interest payments on a given principal
    CalculateInterestPayment = Abs(Application.WorksheetFunction.Pmt(dblInterestRate / lngPaymentsPerYear, lngNumPayments, sglCurrentValue))
End Function

Public Function CalculatePermutations(lngNumberElements As Long, lngNumberPositions) As Double
    'Calculate the number of possible arrangements where the order matters of the number of elements into the number of positions
    CalculatePermutations = Application.WorksheetFunction.Permut(lngNumberElements, lngNumberPositions)
End Function

Public Function EnvironmentVariable(strIn As String) As String
    'Returns the environment variable set on the computer
        'EnvironmentVariable("windir")       'Windows folder
        'EnvironmentVariable("temp")         'Temp folder
        'EnvironmentVariable("username")     'Username
        'EnvironmentVariable("computername") 'Computer name
    EnvironmentVariable = Environ(strIn)
End Function

Private Function ForceForegroundWindow(ByVal hWnd As Long) As Long
    Dim lngThreadID1 As Long
    Dim lngThreadID2 As Long
    Dim lngResult As Long

    If hWnd = GetForegroundWindow() Then
        ForceForegroundWindow = True
    Else
        lngThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
        lngThreadID2 = GetWindowThreadProcessId(hWnd, ByVal 0&)

        If lngThreadID1 <> lngThreadID2 Then
            Call AttachThreadInput(lngThreadID1, lngThreadID2, True)
            lngResult = SetForegroundWindow(hWnd)
            Call AttachThreadInput(lngThreadID1, lngThreadID2, False)
        Else
            lngResult = SetForegroundWindow(hWnd)
        End If

        If IsIconic(hWnd) Then
            Call ShowWindow(hWnd, SW_RESTORE)
        Else
            Call ShowWindow(hWnd, SW_SHOW)
        End If

        ForceForegroundWindow = lngResult
    End If
End Function

Public Function RegistryGetEntry(strSubKeys As String, strValName As String) As String
    'Reads a string value from the HKEY_CURRENT_USER section of the registry
    Const lngType = 1&
    Const lngKey = &H80000001 'HKEY_CURRENT_USER

    Dim lngResult As Long
    Dim lngHandle As Long
    Dim lngcbData As Long
    Dim strRet As String

    On Error Resume Next

    lngResult = RegOpenKeyEx(lngKey, strSubKeys, 0&, KEY_READ, lngHandle)

    If lngResult <> ERROR_SUCCESS Then
        RegistryGetEntry = "!!!KEY DOES NOT EXIST" & vbTab & Format(lngResult)
        Exit Function
    End If

    strRet = String(300, Chr(0))
    lngcbData = Len(strRet)
    lngResult = RegQueryValueEx(lngHandle, strValName, 0&, lngType, ByVal strRet, lngcbData)

    'See if the value to be returned is longer than the number of character positions in the passed in string
    If lngcbData > 300 Then
        'String not long enough, try again
        strRet = String(lngcbData, Chr(0))
        lngResult = RegQueryValueEx(lngHandle, strValName, 0&, lngType, ByVal strRet, lngcbData)
    End If

    If lngResult <> ERROR_SUCCESS Then
        RegistryGetEntry = "!!!VALUE DOES NOT EXIST" & vbTab & Format(lngResult)
    Else
        RegistryGetEntry = Left(strRet, lngcbData - 1)
    End If

    lngResult = RegCloseKey(lngHandle)
End Function

Public Function RegistrySetEntry(strSubKeys As String, strValName As String, strValue As String) As Long
    Const lngType = 1&
    Const lngKey = &H80000001 'HKEY_CURRENT_USER

    Dim lngResult As Long
    Dim lngHandle As Long
    Dim lngcbData As Long
    Dim strRet As String
    Dim strNewKey As String

    On Error Resume Next

    lngResult = RegCreateKey(lngKey, strSubKeys, lngHandle)

    lngResult = RegSetValueEx(lngHandle, strValName, 0&, lngType, ByVal strValue, Len(strValue))

    If lngResult <> ERROR_SUCCESS Then
        RegistrySetEntry = False
    Else
        RegistrySetEntry = True
    End If

    lngResult = RegCloseKey(lngHandle)
End Function

Public Function ReverseString(strIn As Variant) As Variant
    'Reverses a string value using a simple VBA macro
    Dim i As Integer
    Dim strTemp As String

    For i = Len(strIn) To 1 Step -1
        strTemp = strTemp & Mid(strIn, i, 1)
    Next i

    ReverseString = strTemp
End Function

Public Function RoundNumber(dblIn As Double, intDigits As Integer, intPrintCommas As Integer) As String
    'Switch the value of the variable so that TRUE becomes FALSE and FALSE becomes TRUE
    intPrintCommas = Not intPrintCommas
    'Round the number to the specified number of decimal places
    RoundNumber = Application.WorksheetFunction.Fixed(dblIn, intDigits, intPrintCommas)
End Function

Public Function ShowCabinetBuilder(sglMarkup As Single) As Variant
    Dim i As Integer
    Dim intBOMNodes As Integer
    Dim intBOMCount As Integer
    Dim strMaterialList As String

    frmCabinetBuilder.sglPriceMarkup = sglMarkup
    frmCabinetBuilder.Show

    intBOMNodes = frmCabinetBuilder.tvBillOfMaterial.Nodes.Count
    'Set the initial size of the array to be returned to the number of items in the treeview

    intBOMCount = 0
    If (frmCabinetBuilder.intFormCancelled = False) And (intBOMNodes > 0) Then
        For i = 1 To intBOMNodes
            'Do not return the category headings
            If frmCabinetBuilder.tvBillOfMaterial.Nodes(i).Children = 0 Then
                intBOMCount = intBOMCount + 1
                strMaterialList = strMaterialList & frmCabinetBuilder.tvBillOfMaterial.Nodes(i).Text & vbTab
            End If
        Next i
    Else

    End If

    If strMaterialList <> "" Then
        strMaterialList = Left(strMaterialList, Len(strMaterialList) - 1)
    End If

    ShowCabinetBuilder = strMaterialList

    'Remove the form from memory
    Unload frmCabinetBuilder
End Function

Public Sub ShowWindowWithDelay(strWindowTitle As String, Optional intDelaySeconds As Integer = 1, Optional intExitExcel As Integer = False)
    'Used to display a window that is opened within a Visual macro - usually behind the Visual module

    DoEvents
    'Set a couple module level variables that will be used in the ShowWindowAfterDelay sub
    strFindWindowTitle = strWindowTitle
    intFindExitExcel = intExitExcel

    'After the specified number of seconds locate and show the window
    Application.OnTime DateAdd("s", intDelaySeconds, Now), "ShowWindowAfterDelay"
End Sub

Private Sub ShowWindowAfterDelay()
    Dim intLength As Integer 'Length of the window text length
    Dim strListItem As String 'Name of running programs
    Dim lngCurrWnd As Long 'Current window handle
    Dim lngResult As Long 'Return value from the API calls
    Dim intFlag As Integer

    On Error Resume Next

    lngCurrWnd = GetWindow(Application.hWnd, GW_HWNDFIRST)

    'Loop through all of the top-level windows to find the one of interest
    Do While lngCurrWnd <> 0
        intLength = GetWindowTextLength(lngCurrWnd)
        strListItem = Space$(intLength + 1)
        intLength = GetWindowText(lngCurrWnd, strListItem, intLength + 1)
        If intLength > 0 Then
            If InStr(UCase(strListItem), UCase(strFindWindowTitle)) > 0 Then
                lngResult = ForceForegroundWindow(lngCurrWnd)
                DoEvents

                intFlag = True
                Exit Do
            End If
        End If

        lngCurrWnd = GetWindow(lngCurrWnd, GW_HWNDNEXT)

        DoEvents
    Loop

    strFindWindowTitle = ""

    If intFindExitExcel = True Then
        ActiveWorkbook.Saved = True
        Application.Quit
    End If
End Sub

Public Function ToHexadecimal(dblIn As Double) As String
    'Will not work in Excel 2003
    'Changes the number passed in to hexadecimal using a built-in function, could use VB's HEX function
    ToHexadecimal = Application.WorksheetFunction.Dec2Hex(dblIn)
End Function

Public Function ToRoman(dblIn As Double) As String
    'Changes the number passed in to Roman numerals using a built-in function
    ToRoman = Application.WorksheetFunction.Roman(dblIn, 0)
End Function

Public Function VisualINIGet(strSection As String, strName As String, Optional strINIFile As String = "Visual.ini") As String
    Dim lngResult As Long
    Dim lngRetSize As Long
    Dim strLocalVisualDirectory As String
    Dim strFilename As String
    Dim strRet As String

    strLocalVisualDirectory = RegistryGetEntry("Software\Infor Global Solutions\VISUAL Manufacturing\Configuration", "Local Directory")

    If Left(strLocalVisualDirectory, 3) = "!!!" Then
        'Registry access failed, try again with Lilly Software
        strLocalVisualDirectory = RegistryGetEntry("Software\Lilly Software\VISUAL Manufacturing\Configuration", "Local Directory")
    End If

    If (Left(strLocalVisualDirectory, 3) <> "!!!") And (strLocalVisualDirectory <> "") Then
        'Make certain that the path end in a \
        If Right(strLocalVisualDirectory, 1) <> "\" Then
            strLocalVisualDirectory = strLocalVisualDirectory & "\"
        End If

        'Make certain that the ini file ends with .INI
        If Len(strINIFile) > 4 Then
            If Right(UCase(strINIFile), 4) <> ".INI" Then
                strINIFile = strINIFile & ".ini"
            End If
        Else
            strINIFile = strINIFile & ".ini"
        End If

        strFilename = strLocalVisualDirectory & strINIFile

        lngRetSize = 255
        strRet = String(lngRetSize, Chr(0))
        lngResult = GetPrivateProfileString(strSection, strName, "", strRet, lngRetSize, strFilename)

        If lngResult <> 0 Then
            VisualINIGet = Left(strRet, InStr(strRet, Chr(0)) - 1)
        Else
            VisualINIGet = "!!!VALUE DOES NOT EXIST"
        End If
    Else
        'Registry access failed
        VisualINIGet = "!!!LOCATION OF VISUAL.INI NOT KNOWN"
    End If
End Function

Public Function VisualINISet(strSection As String, strName As String, strValue As String, Optional strINIFile As String = "Visual.ini") As Long
    Dim lngResult As Long
    Dim lngRetSize As Long
    Dim strLocalVisualDirectory As String
    Dim strFilename As String
    Dim strRet As String

    strLocalVisualDirectory = RegistryGetEntry("Software\Infor Global Solutions\VISUAL Manufacturing\Configuration", "Local Directory")

    If Left(strLocalVisualDirectory, 3) = "!!!" Then
        'Registry access failed, try again with Lilly Software
        strLocalVisualDirectory = RegistryGetEntry("Software\Lilly Software\VISUAL Manufacturing\Configuration", "Local Directory")
    End If

    If (Left(strLocalVisualDirectory, 3) <> "!!!") And (strLocalVisualDirectory <> "") Then
        'Make certain that the path end in a \
        If Right(strLocalVisualDirectory, 1) <> "\" Then
            strLocalVisualDirectory = strLocalVisualDirectory & "\"
        End If

        'Make certain that the ini file ends with .INI
        If Len(strINIFile) > 4 Then
            If Right(UCase(strINIFile), 4) <> ".INI" Then
                strINIFile = strINIFile & ".ini"
            End If
        Else
            strINIFile = strINIFile & ".ini"
        End If

        strFilename = strLocalVisualDirectory & strINIFile
        lngResult = WritePrivateProfileString(strSection, strName, strValue, strFilename)

        If lngResult <> 0 Then
            VisualINISet = True
        Else
            VisualINISet = False
        End If
    Else
        VisualINISet = False
    End If
End Function

Public Sub ZebraPrintLabel(strPrinter As Variant, strRawText As Variant)
    'Variables for handling printing
    Dim i As Integer
    Dim lngPrinterHandle As Long
    Dim lngResult As Long
    Dim lngWritten As Long
    Dim lngPrinterDocHandle As Long
    Dim bytRawText() As Byte
    Dim MyDocInfo As DOC_INFO_1

    On Error Resume Next

    'In VB6 to see the list of printer device names, enter the following into the Debug window
    'For i = 0 to Printers.Count - 1:Debug.Print Printers(i).DeviceName:Next

    'strPrinter = "\\MYCOMP\ZEBRA"

    'Sample label
    'strRawText = "~SD25^XA" 'Set Darkness, Label start
    'strRawText = strRawText & "^SZ2" 'Enable ZPL2
    'strRawText = strRawText & "^JZ" 'Reprint on error
    'strRawText = strRawText & "^PR8,8,8" 'Print speed 8" per second, 8" per sec slew, 8" per sec backfeed
    'strRawText = strRawText & "^LH10,26" 'Label home position in pixels
    'strRawText = strRawText & "^FO2,14^A0R,20,20^FDMy Company^FS" 'rotated text in font A
    'strRawText = strRawText & "^FO2,480^A0R,20,20^FDSomewhere^FS"
    'strRawText = strRawText & "^FO180,135^B3R,,105,N^FD" & "ABC111" & "^FS"  'Font 3 of 9 barcode
    'strRawText = strRawText & "^FO180,0^GB0,760,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO335,0^GB0,1218,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO550,0^GB0,1218,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO260,760^GB0,452,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO0,760^GB335,0,3^FS"  'Horizontal Line 3 pixels wide
    'strRawText = strRawText & "^XZ"  'End of label indicator

    'Convert the variant data types to strings
    strPrinter = CStr(strPrinter)
    strRawText = CStr(strRawText)

    'Terminate the string with a CRLF combination (may not be needed)
    If Right(strRawText, 2) <> vbCrLf Then
        strRawText = strRawText & vbCrLf
    End If

    'Convert the strRawText string to a byte stream
    ReDim bytRawText(1 To Len(strRawText))
    For i = 1 To Len(strRawText)
        bytRawText(i) = Asc(Mid(strRawText, i, 1))
    Next i

    'Create a connection to the printer, returns a handle to the printer
    lngResult = OpenPrinter(strPrinter, lngPrinterHandle, 0)

    If lngPrinterHandle = 0 Then
        MsgBox "Could Not Open Printer"
        Exit Sub
    End If

    'Fill in the document header structure
    MyDocInfo.pDocName = "Zebra Label from Excel"
    MyDocInfo.pOutputFile = vbNullString
    MyDocInfo.pDatatype = "RAW"
    lngPrinterDocHandle = StartDocPrinter(lngPrinterHandle, 1, MyDocInfo)

    If lngPrinterDocHandle = 0 Then
        MsgBox "Could Not Start the Document"
        lngResult = ClosePrinter(lngPrinterHandle)
        Exit Sub
    End If

    'Prepare to start the first page
    Call StartPagePrinter(lngPrinterHandle)

    'Write out the contents of the first page
    lngResult = WritePrinter(lngPrinterHandle, bytRawText(1), Len(strRawText), lngWritten)
    If lngResult = 0 Then
        MsgBox "Could Not Write to the Page"
        lngResult = ClosePrinter(lngPrinterHandle)
        Exit Sub
    End If

    'End the first page
    lngResult = EndPagePrinter(lngPrinterHandle)

    'End the document
    lngResult = EndDocPrinter(lngPrinterHandle)

    'Close the connection to the printet
    lngResult = ClosePrinter(lngPrinterHandle)
End Sub

OK, now that the easy part is done, we need to Create the UserForm that will be accessed from the VBS script.  From the Insert menu, select UserForm.  Change the name of the form to frmCabinetBuilder.  Draw a Treeview type control on the userform (the treeview is hilighted in the below screen capture) and name the treeview as tvBillOfMaterial.  Draw two ListBox controls on the userform and name them lstWoodType and lstCabinetType (shown below near the upper left of the userform).  Create three CommandButton contols and name them cmdCreateSalesOrder, cmdCreateWorkOrder, and cmdExit (shown near the bottom of the userform).  Create two TextBox controls and name them txtManufactureCost and txtSalesPrice (shown near the top right of the userform).  Create Label controls on the userform above each of the other controls, and set their Caption property to the text that should appear inside the label control (Wood Type, Cabinet Type, etc.).

Next, we need to add code to the userform so that the controls know what to do.  Double-click the background of the userform, delete any code shown, and add the following code:

Option Explicit 'Forces all variables to be declared

Public intFormCancelled As Integer
Public sglPriceMarkup As Single

Dim dbDatabase As New ADODB.Connection
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String

Private Function ConnectDatabase() As Integer
    Dim intResult As Integer

    On Error Resume Next

    If dbDatabase.State <> 1 Then
        'Connection to the database if closed, specify the database name, a username, and password
        strDatabase = "MyDB"
        strUserName = "MyUser"
        strPassword = "MyPassword"

        'Connect to the database
        'Oracle connection string
        dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

        dbDatabase.ConnectionTimeout = 40
        dbDatabase.CursorLocation = adUseClient
        dbDatabase.Open

        If (dbDatabase.State <> 1) Or (Err <> 0) Then
            intResult = MsgBox("Could not connect to the database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo")

            ConnectDatabase = False
        Else
            ConnectDatabase = True
        End If
    Else
        ConnectDatabase = True
    End If
End Function

Private Sub Calculate()
    Const tvwChild = 4

    Dim i As Integer
    Dim sglPrice As Single
    Dim sglBasePrice As Single
    Dim sglWoodPriceMultiplier As Single

    tvBillOfMaterial.Nodes.Clear

    If (lstWoodType.ListIndex >= 0) And (lstCabinetType.ListIndex >= 0) Then
        Select Case lstCabinetType.List(lstCabinetType.ListIndex)
            Case "Base Cabinet Full Depth"
                tvBillOfMaterial.Nodes.Add , , "Door", "Door"
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile1", "Stile 1" & "   " & "3/4 X 2 X 30" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile2", "Stile 2" & "   " & "3/4 X 2 X 30" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail1", "Rail 1" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail2", "Rail 2" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DPanel", "Panel" & "   " & "5/8 X 21 3/4 X 27 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)

                tvBillOfMaterial.Nodes.Add , , "Case", "Case"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile1", "Stile 1" & "   " & "3/4 X 2 X 31" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile2", "Stile 2" & "   " & "3/4 X 2 X 31" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail1", "Rail 1" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail2", "Rail 2" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CKicker", "Kicker" & "   " & "5/8 X 21 3/4 X 27 3/4" & "   " & "Particle Board"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide1", "Side 1" & "   " & "3/4 X 24 X 35" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide2", "Side 2" & "   " & "3/4 X 24 X 35" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBack", "Back" & "   " & "3/4 X 22 1/2 X 35" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CTop", "Top" & "   " & "3/4 X 22 1/2 X 23 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBottom", "Bottom" & "   " & "3/4 X 22 1/2 X 23 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"

                sglBasePrice = 150
            Case "Base Cabinet Half Depth"
                tvBillOfMaterial.Nodes.Add , , "Door", "Door"
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile1", "Stile 1" & "   " & "3/4 X 2 X 30" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile2", "Stile 2" & "   " & "3/4 X 2 X 30" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail1", "Rail 1" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail2", "Rail 2" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DPanel", "Panel" & "   " & "5/8 X 21 3/4 X 27 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)

                tvBillOfMaterial.Nodes.Add , , "Case", "Case"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile1", "Stile 1" & "   " & "3/4 X 2 X 31" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile2", "Stile 2" & "   " & "3/4 X 2 X 31" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail1", "Rail 1" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail2", "Rail 2" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CKicker", "Kicker" & "   " & "5/8 X 21 3/4 X 27 3/4" & "   " & "Particle Board"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide1", "Side 1" & "   " & "3/4 X 12 X 35" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide2", "Side 2" & "   " & "3/4 X 12 X 35" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBack", "Back" & "   " & "3/4 X 22 1/2 X 35" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CTop", "Top" & "   " & "3/4 X 22 1/2 X 11 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBottom", "Bottom" & "   " & "3/4 X 22 1/2 X 11 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"

                sglBasePrice = 120
            Case "Full Height Base Cabinet"
                tvBillOfMaterial.Nodes.Add , , "Door", "Door"
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile1", "Stile 1" & "   " & "3/4 X 2 X 67" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile2", "Stile 2" & "   " & "3/4 X 2 X 67" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail1", "Rail 1" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail2", "Rail 2" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DPanel", "Panel" & "   " & "5/8 X 21 3/4 X 63 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)

                tvBillOfMaterial.Nodes.Add , , "Case", "Case"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile1", "Stile 1" & "   " & "3/4 X 2 X 72" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile2", "Stile 2" & "   " & "3/4 X 2 X 72" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail1", "Rail 1" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail2", "Rail 2" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CKicker", "Kicker" & "   " & "5/8 X 21 3/4 X 27 3/4" & "   " & "Particle Board"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide1", "Side 1" & "   " & "3/4 X 24 X 72" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide2", "Side 2" & "   " & "3/4 X 24 X 72" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBack", "Back" & "   " & "3/4 X 22 1/2 X 72" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CTop", "Top" & "   " & "3/4 X 22 1/2 X 23 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBottom", "Bottom" & "   " & "3/4 X 22 1/2 X 23 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"

                sglBasePrice = 250
            Case "Upper Cabinet"
                tvBillOfMaterial.Nodes.Add , , "Door", "Door"
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile1", "Stile 1" & "   " & "3/4 X 2 X 9 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile2", "Stile 2" & "   " & "3/4 X 2 X 9 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail1", "Rail 1" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail2", "Rail 2" & "   " & "3/4 X 2 X 21 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DPanel", "Panel" & "   " & "5/8 X 21 3/4 X 9 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)

                tvBillOfMaterial.Nodes.Add , , "Case", "Case"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile1", "Stile 1" & "   " & "3/4 X 2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile2", "Stile 2" & "   " & "3/4 X 2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail1", "Rail 1" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail2", "Rail 2" & "   " & "3/4 X 2 X 24" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide1", "Side 1" & "   " & "3/4 X 11 1/4 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide2", "Side 2" & "   " & "3/4 X 11 1/4 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBack", "Back" & "   " & "3/4 X 22 1/2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CTop", "Top" & "   " & "3/4 X 22 1/2 X 11 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBottom", "Bottom" & "   " & "3/4 X 22 1/2 X 11 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"

                sglBasePrice = 100
            Case "Upper Cabinet Narrow"
                tvBillOfMaterial.Nodes.Add , , "Door", "Door"
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile1", "Stile 1" & "   " & "3/4 X 2 X 9 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DStile2", "Stile 2" & "   " & "3/4 X 2 X 9 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail1", "Rail 1" & "   " & "3/4 X 2 X 9 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DRail2", "Rail 2" & "   " & "3/4 X 2 X 9 3/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Door", tvwChild, "DPanel", "Panel" & "   " & "5/8 X 9 3/4 X 9 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex)

                tvBillOfMaterial.Nodes.Add , , "Case", "Case"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile1", "Stile 1" & "   " & "3/4 X 2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CStile2", "Stile 2" & "   " & "3/4 X 2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail1", "Rail 1" & "   " & "3/4 X 2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CRail2", "Rail 2" & "   " & "3/4 X 2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex)
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide1", "Side 1" & "   " & "3/4 X 11 1/4 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CSide2", "Side 2" & "   " & "3/4 X 11 1/4 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBack", "Back" & "   " & "3/4 X 10 1/2 X 12" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CTop", "Top" & "   " & "3/4 X 10 1/2 X 11 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"
                tvBillOfMaterial.Nodes.Add "Case", tvwChild, "CBottom", "Bottom" & "   " & "3/4 X 10 1/2 X 11 1/4" & "   " & lstWoodType.List(lstWoodType.ListIndex) & " Plywood"

                sglBasePrice = 60
        End Select

        Select Case lstWoodType.List(lstWoodType.ListIndex)
            Case "Birch"
                sglWoodPriceMultiplier = 3.2
            Case "Cedar"
                sglWoodPriceMultiplier = 2.4
            Case "Cherry"
                sglWoodPriceMultiplier = 6
            Case "Douglas Fir"
                sglWoodPriceMultiplier = 2.8
            Case "Ebony"
                sglWoodPriceMultiplier = 12
            Case "Maple"
                sglWoodPriceMultiplier = 3.3
            Case "Pine"
                sglWoodPriceMultiplier = 1.5
            Case "Poplar"
                sglWoodPriceMultiplier = 1.3
            Case "Red Oak"
                sglWoodPriceMultiplier = 2.5
            Case "Redwood"
                sglWoodPriceMultiplier = 6
            Case "Spruce"
                sglWoodPriceMultiplier = 1
            Case "White Oak"
                sglWoodPriceMultiplier = 3
        End Select

        If sglPriceMarkup = 0 Then
            sglPriceMarkup = 0.3
        End If

        sglPrice = Round((sglBasePrice * sglWoodPriceMultiplier) * (1 + sglPriceMarkup), 2)

        txtSalesPrice = Format(sglPrice, "$0.00")
        txtManufactureCost = Format(Round((sglBasePrice * sglWoodPriceMultiplier), 2), "$0.00")
    End If

    For i = 1 To tvBillOfMaterial.Nodes.Count
        'Force all of the nodes to appear expanded
        tvBillOfMaterial.Nodes(i).Expanded = True
    Next i
    If tvBillOfMaterial.Nodes.Count > 0 Then
        tvBillOfMaterial.Nodes(1).Selected = True
    End If
End Sub

Private Sub cmdExit_Click()
    'Set the variable to indicate that the user did not force the window to close
    intFormCancelled = False

    'Make the form disappear
    Me.Hide
End Sub

Private Sub lstCabinetType_Click()
    Calculate
End Sub

Private Sub lstWoodType_Click()
    Calculate
End Sub

Private Sub UserForm_Initialize()
    Dim lngResult As Long
    Dim strSQL As String
    Dim snpData As ADODB.Recordset

    On Error Resume Next

    Set snpData = New ADODB.Recordset

    lngResult = ConnectDatabase

    If lngResult = True Then
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  WOOD_TYPE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  CABINET_BUILDER_WOOD" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  WOOD_TYPE"
        snpData.Open strSQL, dbDatabase

        If snpData.State = 1 Then
            Do While Not snpData.EOF
                lstWoodType.AddItem snpData("wood_type")

                snpData.MoveNext
            Loop

            snpData.Close
        End If

        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  CABINET_TYPE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  CABINET_BUILDER_CAB_TYPE" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  CABINET_TYPE"
        snpData.Open strSQL, dbDatabase

        If snpData.State = 1 Then
            Do While Not snpData.EOF
                lstCabinetType.AddItem snpData("cabinet_type")

                snpData.MoveNext
            Loop

            snpData.Close
        End If
    End If

    Set snpData = Nothing
    'lstWoodType.List = Array("Birch", "Cedar", "Cherry", "Douglas Fir", "Ebony", "Maple", "Pine", "Poplar", "Red Oak", "Redwood", "Spruce", "White Oak")
    'lstCabinetType.List = Array("Base Cabinet Full Depth", "Base Cabinet Half Depth", "Full Height Base Cabinet", "Upper Cabinet", "Upper Cabinet Narrow")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    'Prevent the form from being unloaded
    Cancel = True

    'Set the variable to indicate that the user closed the window
    intFormCancelled = True

    'Make the form disappear
    Me.Hide
End Sub

To keep matters simple, I elected to not pull up the costs for the various cabinets, the price premiums for different wood types, or the bill of material from the database.  If all was successful, at this point you should be able to type the following into the Immediate Window to show the userform:

a = ShowCabinetBuilder( 1 )

Almost done, now we just need the VBS script that will interact with the Excel workbook.  Use Notepad to create a new text file named “C:\ExcelMacroFunctionsDemo.vbs” and add the following code:

Dim i
Dim objExcel
Dim objShell
Dim sglResult
Dim strResult
Dim strBOM
Dim strMaterial
Dim strOut
Dim strOpenDate
Dim strVendorID

Set objExcel = CreateObject("Excel.Application")

strOpenDate = cDate("January 7, 2010")
strVendorID = "MyCompanyHere"

strOut = ""
With objExcel
    'Open the Excel file containing the macro functions
    .Workbooks.Open "C:\ExcelMacroFunctionDemo.xls"

    'Excute a standard macro located in mdlGlobal, pass in the vendor ID from Visual
    strResult = .Application.Run("ReverseString", strVendorID)
    strOut = strOut & "Execute a Custom Excel Macro:" & vbCrLf
    strOut = strOut & " The vendor ID spelled backward is " & strResult & vbCrLf

    'Excute a macro located in mdlGlobal that calls an internal Excel function
    strResult = .Application.Run("ToRoman", Year(strOpenDate))
    strOut = strOut & vbCrLf & "Execute a Custom Excel Macro - Calls Int. Excel Func:" & vbCrLf
    strOut = strOut & " The open date year in Roman numerals is " & strResult & vbCrLf

    'Excute a macro located in mdlGlobal that calls an internal Excel function, function not available on Excel 2003
    'strResult = .Application.Run("ToHexadecimal", Year(strOpenDate))
    'strOut = strOut & "The open date year in Hexadecimal is " & strResult & vbCrLf

    'Excute a macro located in mdlGlobal that calls an internal Excel function
    strResult = .Application.Run("CalculateCombinations", 5, 3)
    strOut = strOut & " There are " & strResult & " cominations of 5 objects arranged in 3 slots" & vbCrLf
    strResult = .Application.Run("CalculateCombinations", 5, 4)
    strOut = strOut & " There are " & strResult & " cominations of 5 objects arranged in 4 slots" & vbCrLf
    strResult = .Application.Run("CalculatePermutations", 5, 3)
    strOut = strOut & " There are " & strResult & " permutations of 5 objects arranged in 3 slots" & vbCrLf
    strResult = .Application.Run("CalculatePermutations", 5, 4)
    strOut = strOut & " There are " & strResult & " permutations of 5 objects arranged in 4 slots" & vbCrLf

    'Excute a macro located in mdlGlobal that calls an internal Excel function with multiple parameters
    sglResult = .Application.Run("CalculateInterestPayment", 0.07, 12, 4 * 12, 30000)
    strOut = strOut & " A monthly payment on a $30,000 loan at 7% interest is $" & FormatNumber(sglResult, 2) & " for 4 years" & vbCrLf   

    'Directly execute an internal Excel function, function not available on Excel 2003
    'sglResult = .Application.WorksheetFunction.NetworkDays(Date, cDate("12/31/" & cStr(Year(Now))))
    'strOut = strOut & "There are " & cStr(sglResult) & " week days left in the year" & vbCrLf

    'Directly execute an internal Excel function
    strOut = strOut & vbCrLf & "Directly Execute Internal Excel Func:" & vbCrLf
    sglResult = .Application.WorksheetFunction.Average(10,3,4,5,6,100)
    strOut = strOut & " The average of 10,3,4,5,6,100 is " & cStr(sglResult) & vbCrLf
    sglResult = .Application.WorksheetFunction.Product(10,3,4,5,6,100)
    strOut = strOut & " The product of 10,3,4,5,6,100 is " & cStr(sglResult) & vbCrLf
    sglResult = .Application.WorksheetFunction.StDev(10,3,4,5,6,100)
    strOut = strOut & " The standard deviation of 10,3,4,5,6,100 is " & cStr(sglResult) & vbCrLf
    MsgBox strOut, vbInformation, "Excel Macro Functions"

    strOut = ""
    'Excute a macro located in mdlGlobal that retrieves a value from one of Visual's INI files
    strOut = strOut & "Read Values from Visual INIs:" & vbCrLf
    strResult = .Application.Run("VisualINIGet", "PlanningWindow", "ShowUnreleased", "Visual.ini")
    If (Left(Ucase(strResult), 1) = "Y") Or (Left(Ucase(strResult), 1) = "1") Then
        strOut = strOut & " The Material Planning Window will show Unreleased orders" & vbCrLf
    Else
        strOut = strOut & " The Material Planning Window will show Not Unreleased orders" & vbCrLf
    End IF
    strResult = .Application.Run("VisualINIGet", "Work Orders", "table", "vmbrowse.ini")
    strOut = strOut & " WO Browse tables=: " & strResult & vbCrLf
    strResult = .Application.Run("VisualINIGet", "Work Orders", "where", "vmbrowse.ini")
    strOut = strOut & " WO Browse where=: " & strResult & vbCrLf
    strResult = .Application.Run("VisualINIGet", "Work Orders", "decode", "vmbrowse.ini")
    strOut = strOut & " WO Browse columns=: " & strResult & vbCrLf
    MsgBox strOut, vbInformation, "Excel Macro Functions"

    strOut = ""
    'Excute a macro located in mdlGlobal that retrieves values from the registry
    strOut = strOut & "Read Values from Windows Registry:" & vbCrLf
    strResult = .Application.Run("RegistryGetEntry", "Control Panel\Desktop", "Wallpaper")
    strOut = strOut & " Desktop Picture: " & strResult & vbCrlf

    'Excute a macro located in mdlGlobal that retrieves environment variables
    strOut = strOut & vbCrLf & "Read Values from Windows Env Variables:" & vbCrLf
    strResult = .Application.Run("EnvironmentVariable", "username")
    strOut = strOut & " User: " & strResult
    strResult = .Application.Run("EnvironmentVariable", "computername")
    strOut = strOut & " is logged into the computer: " & strResult
    strResult = .Application.Run("EnvironmentVariable", "windir")
    strOut = strOut & " with the Windows folder located in: " & strResult
    strResult = .Application.Run("EnvironmentVariable", "temp")
    strOut = strOut & " and the temp folder is located in: " & strResult
    MsgBox strOut, vbInformation, "Excel Macro Functions"

    'Show an Excel user form by calling a public macro function in the located in mdlGlobal module
    strResult = InputBox("Enter Markup Percent (for example  50) for Cabinet Builder", "Excel Macro Functions")
    If IsNumeric(strResult) Then
        'with the help of custom program, set a 1 second delay, then force the window to the top
        Set objShell = CreateObject("WScript.Shell")
        objShell.Run("C:\BringToTop.exe " & Chr(34) & "Cabinet Builder" & Chr(34) & " 1")

        strBOM = .Application.Run("ShowCabinetBuilder", cSng(strResult) / 100)

        Set objShell = Nothing

        'BOM is tab delimited, split apart
        strMaterial = Split(cStr(strBOM), vbTab)

        strOut = "Show an Excel user form on demand:" & vbCrLf
        strOut = strOut & "Bill of Material" & vbCrLf     

        For i = 0 To UBound(strMaterial)
            strOut = strOut & strMaterial(i) & vbCrLf
        Next

        MsgBox strOut, vbInformation, "Excel Macro Functions"
    End If
End With

objExcel.DisplayAlerts = False
objExcel.ActiveWorkbook.Saved = True
objExcel.Quit
Set objExcel = Nothing  

Now for a test run.  Save the Excel worksheet and exit Excel.  In Windows Explorer, double-click the C:\ExcelMacroFunctionDemo.vbs file.  The second screen capture will likely be blank if you try to run the script as it is, but my output looks like the following:

Clicking OK displayed the following on my computer, but it will probably be blank on your computer:

Clicking OK causes the VBS macro to access the Excel macro code that retrieves information from the Windows registry and environment variables:

Next, the computer will ask for a mark up percent.  Specify a value, such as 50 or 100:

Next, the cabinet builder interface appears.  Pick a type of wood and a cabinet type.  The percentage specified earlier will be multiplied by the manufacture cost to arrive at the sales price.  A fake bill of material will appear near the bottom of the window.

When the Exit button is clicked, the bill of material is returned to the VBS script, and then displayed on the screen.

While this specific example might not be very useful, it does demonstrate how to use an Excel userform as an interface for a VBS script – and the username and password used to access the database are not in clear text in the VBS script.

Shortcut: save all of the following in the root of the C:\ drive and remove the .doc extension at the end of the filenames.

ExcelMacroFunctionDemo.xls

ExcelMacroFunctionDemo.vbs

BringToTop.exe (only needed on Vista and Windows 7)