Send an Email From Excel, Visual Basic 6, or a Windows Command Line Using Oracle’s UTL_MAIL Package

30 11 2012

November 30, 2012

(Back to the Previous Post in the Series)

Today is this blog’s third anniversary, so to celebrate, I thought that I would share a simple code example.  As many regular readers of this blog probably know, Oracle Database 10.1 introduced the UTL_MAIL package, which allowed programs accessing Oracle Database to easily send emails without using the more complex UTL_SMTP package.  Using UTL_MAIL requires that:

  1. The SMTP_OUT_SERVER parameter is set correctly, and potentially the email server is configured to permit receiving SMTP emails from the Oracle Database server.
  2. The utlmail.sql and prvtmail.plb scripts (found in the rdbms/admin directory of the Oracle home) are executed to create the UTL_MAIL package components in the database.
  3. The Oracle user account that will access the UTL_MAIL package’s procedures has sufficient access permissions for the package.

A couple of years ago I wrote an article that showed how to schedule the periodic sending of an email using UTL_MAIL – that article might also be of interest if you find this article helpful.

Let’s take a look at sample code that is compatible with Visual Basic 6 (VB 6) and the scripting language in Excel (the same scripting language is also available in Microsoft Word, Excel, Power Point, Outlook, Access, etc.):

Dim intResult As Integer
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String
Dim strSQL As String
Dim dbDatabase As ADODB.Connection
Dim comEmail As ADODB.Command

On Error Resume Next

strDatabase = "MyDB" 'From tnsnames.ora
strUserName = "MyUserID"
strPassword = "MyPassword"

Set dbDatabase = New ADODB.Connection

dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";"
dbDatabase.Open

If (dbDatabase.State = 1) And (Err = 0) Then
    Set comEmail = New ADODB.Command

    With comEmail
        strSQL = "UTL_MAIL.SEND(" & vbCrLf
        strSQL = strSQL & "  'VisitorRegister@mysite.com'," & vbCrLf
        strSQL = strSQL & "  'MyRecipient1@mysite.com;MyRecipient2@mysite.com'," & vbCrLf
        strSQL = strSQL & "  null," & vbCrLf  'CC
        strSQL = strSQL & "  null," & vbCrLf  'BCC
        strSQL = strSQL & "  '" & strMessageSubject & "'," & vbCrLf
        strSQL = strSQL & "  '" & strMessage & "')"
        .CommandText = strSQL
        .CommandType = adCmdStoredProc                        ' Const adCmdStoredProc = 4
        .ActiveConnection = dbDatabase
    End With

    comEmail.Execute
End If

Set comEmail = Nothing

The sample code looks quite similar to code that has appeared on this site in the past (as such, regular readers will know that MyDB, MyUserID, and MyPassword should be changed to appropriate values for your database), were an ADO Command type object is set up to execute a SQL statement with bind variables.  The difference, however, is that there are no bind variables in the SQL statement, and the CommandType is set to adCmdStoredProc, rather than adCmdText.  Before we are able to use the above code sample, we must first add a reference in the project to the Microsoft ActiveX Data Objects Library:

connect-with-vb-6-references-2

Looks to be very simple, right?  But wait, maybe it would be better that the call to UTL_MAIL use bind variables, rather than literals, to not only save some space in the library cache, but also to make it a bit more difficult for the DBA to read sent emails from Oracle Database’s various V$ views, and to make it easier to include apostrophes (single quotes), line breaks, and other email formatting commands in the email message.

We might try to use something like the following, replacing literals with bind variable placeholders, as a replacement for the above code:

Dim intResult As Integer
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String
Dim strSQL As String
Dim dbDatabase As ADODB.Connection
Dim comEmail As ADODB.Command

On Error Resume Next

strDatabase = "MyDB" 'From tnsnames.ora
strUserName = "MyUserID"
strPassword = "MyPassword"

Set dbDatabase = New ADODB.Connection

dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";"
dbDatabase.Open

If (dbDatabase.State = 1) And (Err = 0) Then
    Set comEmail = New ADODB.Command

    With comEmail
        strSQL = "UTL_MAIL.SEND(" & vbCrLf
        strSQL = strSQL & "  ? ," & vbCrLf
        strSQL = strSQL & "  ? ," & vbCrLf
        strSQL = strSQL & "  ? ," & vbCrLf
        strSQL = strSQL & "  ? ," & vbCrLf
        strSQL = strSQL & "  ? ," & vbCrLf
        strSQL = strSQL & "  ? )"
        .CommandText = strSQL
        .CommandType = adCmdStoredProc ' Const adCmdStoredProc = 4
        .ActiveConnection = dbDatabase

        .Parameters.Append .CreateParameter("sender", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("recipients", adVarChar, adParamInput, 500)
        .Parameters.Append .CreateParameter("cc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("bcc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("subject", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("message", adVarChar, adParamInput, 500)
    End With

    comEmail("sender") = "VisitorRegister@mysite.com"
    comEmail("recipients") = "MyRecipient1@mysite.com;MyRecipient2@mysite.com"
    comEmail("subject") = strMessageSubject
    comEmail("message") = strMessage
    comEmail.Execute
End If

Set comEmail = Nothing

Well, that was easy, when executed, the code results in an error message that reads: “Unspecified Error“!  Fine, don’t tell me what is wrong… I will just search the Internet for the answer.

Hey, a site recommended using named variable in the SQL statement, rather than the usual question mark bind placeholders in the SQL statement to be executed, something similar to the following:

Dim intResult As Integer
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String
Dim strSQL As String
Dim dbDatabase As ADODB.Connection
Dim comEmail As ADODB.Command

On Error Resume Next

strDatabase = "MyDB" 'From tnsnames.ora
strUserName = "MyUserID"
strPassword = "MyPassword"

Set dbDatabase = New ADODB.Connection

dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";"
dbDatabase.Open

If (dbDatabase.State = 1) And (Err = 0) Then
    Set comEmail = New ADODB.Command

    With comEmail
        strSQL = "UTL_MAIL.SEND(" & vbCrLf
        strSQL = strSQL & "  :sender ," & vbCrLf
        strSQL = strSQL & "  :recipients ," & vbCrLf
        strSQL = strSQL & "  :cc ," & vbCrLf
        strSQL = strSQL & "  :bcc ," & vbCrLf
        strSQL = strSQL & "  :subject ," & vbCrLf
        strSQL = strSQL & "  :message )"
        .CommandText = strSQL
        .CommandType = adCmdStoredProc ' Const adCmdStoredProc = 4
        .ActiveConnection = dbDatabase

        .Parameters.Append .CreateParameter("sender", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("recipients", adVarChar, adParamInput, 500)
        .Parameters.Append .CreateParameter("cc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("bcc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("subject", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("message", adVarChar, adParamInput, 500)
    End With

    comEmail("sender") = "VisitorRegister@mysite.com"
    comEmail("recipients") = "MyRecipient1@mysite.com;MyRecipient2@mysite.com"
    comEmail("subject") = strMessageSubject
    comEmail("message") = strMessage

    comEmail.Execute
End If

Set comEmail = Nothing

Well, that was easy, resulting in an error message that reads: “Unspecified Error! Fine, don’t tell me what is wrong, I will just guess.

Oh, a book recommended putting “Begin ” before the UTL_MAIL in the SQL statement, and “; END;” just after the “)” in the SQL statement.  “Unspecified Error“!

10046 trace at level 12 to see what Oracle Database rejected?  Sorry, no SQL statements that were attempted to be directly executed by the application appeared in the trace file.

Well, obviously it must be possible to execute stored procedures, such as those in the UTL_MAIL package, with bind variables from within Visual Basic 6 or Excel.  Maybe we are just trying too hard?  How about something like this:

Dim intResult As Integer
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String
Dim strSQL As String
Dim dbDatabase As ADODB.Connection
Dim comEmail As ADODB.Command

On Error Resume Next

strDatabase = "MyDB" 'From tnsnames.ora
strUserName = "MyUserID"
strPassword = "MyPassword"

Set dbDatabase = New ADODB.Connection

dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";"
dbDatabase.Open

If (dbDatabase.State = 1) And (Err = 0) Then
    Set comEmail = New ADODB.Command

    With comEmail
        strSQL = "UTL_MAIL.SEND"

        .CommandText = strSQL
        .CommandType = adCmdStoredProc ' Const adCmdStoredProc = 4
        .ActiveConnection = dbDatabase

        .Parameters.Append .CreateParameter("sender", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("recipients", adVarChar, adParamInput, 500)
        .Parameters.Append .CreateParameter("cc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("bcc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("subject", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("message", adVarChar, adParamInput, 500)
    End With

    comEmail("sender") = "VisitorRegister@mysite.com"
    comEmail("recipients") = "MyRecipient1@mysite.com;MyRecipient2@mysite.com"
    comEmail("subject") = strMessageSubject
    comEmail("message") = strMessage

    comEmail.Execute
End If

Set comEmail = Nothing

Well that was easy, although it might seem a little confusing not being permitted to specify essentially the same (literal) SQL statement as was used originally, just with bind variable placeholders when calling UTL_MAIL procedures.

The title of this article seems to suggest that we are able to call Oracle’s UTL_MAIL package procedures from the Windows command line – that is almost true.  We need to create a plain text file using Notepad (or a similar tool), and simply make a couple of changes to the above code sample so that variable types are not declared (this code example has not been tested yet):

Dim intResult
Dim strDatabase
Dim strUserName
Dim strPassword
Dim strSQL
Dim dbDatabase
Dim comEmail

Const adCmdStoredProc = 4
Const adVarChar = 200
Const adParamInput = 1

On Error Resume Next

strDatabase = "MyDB" 'From tnsnames.ora
strUserName = "MyUserID"
strPassword = "MyPassword"

Set dbDatabase = CreateObject("ADODB.Connection")

dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";"
dbDatabase.Open

If (dbDatabase.State = 1) And (Err = 0) Then
    Set comEmail = CreateObject("ADODB.Command")

    With comEmail
        strSQL = "UTL_MAIL.SEND"

        .CommandText = strSQL
        .CommandType = adCmdStoredProc
        .ActiveConnection = dbDatabase

        .Parameters.Append .CreateParameter("sender", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("recipients", adVarChar, adParamInput, 500)
        .Parameters.Append .CreateParameter("cc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("bcc", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("subject", adVarChar, adParamInput, 100)
        .Parameters.Append .CreateParameter("message", adVarChar, adParamInput, 500)
    End With

    comEmail("sender") = "VisitorRegister@mysite.com"
    comEmail("recipients") = "MyRecipient1@mysite.com;MyRecipient2@mysite.com"
    comEmail("subject") = strMessageSubject
    comEmail("message") = strMessage

    comEmail.Execute
End If

Set comEmail = Nothing

Then, all that we need to do is execute the saved plain text file using either the cscript or wscript command from the Windows command line.

A year older, any wiser?





Oracle Database Time Model Viewer in Excel 6

18 08 2011

August 18, 2011

(Back to the Previous Post in the Series)

It has been roughly five months since the last installment in this blog article series.  Hopefully, several people have found this series helpful and have adapted the solution to better fit their specific needs.  By the end of the last article the Excel based application not only displayed time model data at the system-wide and session-level, but also operating system statistics (from V$OSSTAT), system-wide and session level wait events, various other statistics (from V$SYSSTAT), execution plans, and also allowed enabling/disabling 10046 extended SQL traces.  A lot of features, but what else may be added to the project?

As of part four of the series, the Excel project should appear similar to the following screen capture (10046 tracing and DBMS XPLAN were added in part five):

You can find the current project, through part five of this series, linked at the bottom of part five’s blog article.  Open that project (or your customized version of the project), right-click the Sheet2 worksheet name and select Rename.  Change the name to Statistics.  Rename the Sheet3 worksheet to Charts by using the same process.  Finally, right-click the Wait Events worksheet name and select View Code.  Expand the Forms group, right-click the frmTimeModel name, and select View Source.  Just before selecting View Source (or View Code), your editor window should appear similar to the following screen capture:

Locate the UserForm_Initialize subroutine (this is the subroutine that connects to the database and prepares to start retrieving statistics from the database).  Locate the following code in that subroutine:

'More code will be copied here
'
'
'

Just above that section of code, add the following commands which will add column titles to the Statistics worksheet when the UserForm is displayed:

'   
    Sheets("Wait Events").Range("B2").Select
    ActiveWindow.FreezePanes = True

    Sheets("Statistics").Cells(1, 1).Value = "Time"
    Sheets("Statistics").Cells(1, 2).Value = "Administrative"
    Sheets("Statistics").Cells(1, 3).Value = "Application"
    Sheets("Statistics").Cells(1, 4).Value = "Commit"
    Sheets("Statistics").Cells(1, 5).Value = "Concurrency"
    Sheets("Statistics").Cells(1, 6).Value = "Configuration"
    Sheets("Statistics").Cells(1, 7).Value = "Network"
    Sheets("Statistics").Cells(1, 8).Value = "Other"
    Sheets("Statistics").Cells(1, 9).Value = "System I/O"
    Sheets("Statistics").Cells(1, 10).Value = "User I/O"

    Sheets("Statistics").Columns("B:AC").EntireColumn.AutoFit

    Sheets("Statistics").Rows("2:10000").Delete Shift:=xlUp

Next, we will programmatically create four charts on the Charts worksheet.  Directly below were the above code was copied (above the ‘More code will be copied here line), add the following code:

    'Remove existing charts, Add the charts
    Sheets("Charts").ChartObjects.Delete

    'Note that these chart styles are likely only compatible with Excel 2007 and later
    With Sheets("Charts").ChartObjects.Add(10, 10, 400, 200)
        .Chart.SetSourceData Source:=Sheets("Statistics").Range("$B$1:$J$21")
        .Chart.SeriesCollection(1).XValues = "='Statistics'!$A$2:$A$21"
        .Chart.ChartType = xlColumnStacked 'xlAreaStacked
        .Chart.HasTitle = True
        .Chart.ChartStyle = 42
        .Chart.ChartTitle.Text = "Wait Event Classes"

        'Rotate the X axis titles
        .Chart.Axes(xlCategory).TickLabels.Orientation = xlUpward

        'Add the vertical Y axis title
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Seconds"
        'Add a gradient to the background of the chart
        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
    End With
    With Sheets("Charts").ChartObjects.Add(410, 10, 400, 200)
        .Chart.SetSourceData Source:=Sheets("Statistics").Range("$W$1:$AC$21")
        .Chart.SeriesCollection(1).XValues = "='Statistics'!$A$2:$A$21"
        .Chart.ChartType = xlColumn 'xlArea
        .Chart.HasTitle = True
        .Chart.ChartStyle = 42
        .Chart.ChartTitle.Text = "DB Time and CPU"

        'Rotate the X axis titles
        .Chart.Axes(xlCategory).TickLabels.Orientation = xlUpward

        'Add the vertical Y axis title
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Seconds"

        'Add a gradient to the background of the chart
        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
    End With

    With Sheets("Charts").ChartObjects.Add(10, 215, 400, 200)
        .Chart.SetSourceData Source:=Sheets("Statistics").Range("$S$1:$T$21")
        .Chart.SeriesCollection(1).XValues = "='Statistics'!$A$2:$A$21"
        .Chart.ChartType = xlColumnStacked 'xlAreaStacked
        .Chart.HasTitle = True
        .Chart.ChartStyle = 42
        .Chart.ChartTitle.Text = "Server-Wide CPU Usage"

        'Rotate the X axis titles
        .Chart.Axes(xlCategory).TickLabels.Orientation = xlUpward

        'Add the vertical Y axis title
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Seconds"

        'Add a gradient to the background of the chart
        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
    End With
    With Sheets("Charts").ChartObjects.Add(410, 215, 400, 200)
        .Chart.SetSourceData Source:=Sheets("Statistics").Range("$O$1:$P$21")
        .Chart.SeriesCollection(1).XValues = "='Statistics'!$A$2:$A$21"
        .Chart.ChartType = xlAreaStacked100 'xlColumnStacked100 'xlAreaStacked100
        .Chart.HasTitle = True
        .Chart.ChartStyle = 42
        .Chart.ChartTitle.Text = "Server-Wide CPU Utilization"

        'Rotate the X axis titles
        .Chart.Axes(xlCategory).TickLabels.Orientation = xlUpward

        'Add the vertical Y axis title
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Percent"

        'Add a gradient to the background of the chart
        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
    End With

Let’s also change a couple of default settings found on the UserForm and correct the (intentional) spelling error found in the titlebar of the UserForm by using a couple of lines of code directly below the above code:

    chkPauseRefresh.Value = True
    chkDisplaySessionDetail.Value = True
    chkExcludeIdleWaits.Value = True
    Me.Caption = "Charles Hooper's Time Model Viewer in Microsoft Excel"

Now that the code to generate the blank charts has been added to the UserForm, we need code to add the chart data to the Statistics worksheet.  If I so chose, rather than adding the data to the Statistics worksheet, I could simply build an array of numbers and use that array as the charts’ source data, however it might at times be helpful to see the raw data that is presented in the chart.  Locate the UpdateDisplay subroutine in the UserForm’s code (Public Sub UpdateDisplay).  In that subroutine, locate the following line:

tvTimeModel.Nodes.Clear

Just above that line, add the following code:

'Added in Article 6
    If dblDBTimeLast > 0 Then
        'Note that the first two methods cause the data source range for the charts to shift down 1 row, so copty-paste is used
        'Sheets("Statistics").Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        'Range("Statistics!A2:AC1000").Cut Destination:=Range("Statistics!A3:AC1001")
        Sheets("Statistics").Range("A2:AC1000").Copy
        Sheets("Statistics").Range("A3:AC1001").PasteSpecial xlPasteValuesAndNumberFormats
        Sheets("Statistics").Range("A2").Select
        Sheets("Statistics").Cells(2, 1) = Format(Now, "hh:nn am/pm")
        Sheets("Statistics").Cells(2, 2) = 0
        Sheets("Statistics").Cells(2, 3) = 0
        Sheets("Statistics").Cells(2, 4) = 0
        Sheets("Statistics").Cells(2, 5) = 0
        Sheets("Statistics").Cells(2, 6) = 0
        Sheets("Statistics").Cells(2, 7) = 0
        Sheets("Statistics").Cells(2, 8 ) = 0
        Sheets("Statistics").Cells(2, 9) = 0
        Sheets("Statistics").Cells(2, 10) = 0

        Sheets("Statistics").Cells(2, 15) = Val(lblBusyTime)
        Sheets("Statistics").Cells(2, 16) = Val(lblIdleTime)
        Sheets("Statistics").Cells(2, 17) = Val(lblBusyPercent)

        Sheets("Statistics").Cells(2, 19) = Val(lblUserMode)
        Sheets("Statistics").Cells(2, 20) = Val(lblKernelMode)
        Sheets("Statistics").Cells(2, 21) = Val(lblUserModePercent)

        Sheets("Statistics").Cells(2, 23) = Format((dblDBTime - dblDBTimeLast) / 1000000, "0.00")
        Sheets("Statistics").Cells(2, 24) = Format((dblDBCPU - dblDBCPULast) / 1000000, "0.00")
        Sheets("Statistics").Cells(2, 25) = Val(lblCPUUsedBySession)
        Sheets("Statistics").Cells(2, 26) = Val(lblParseTimeCPU)
        Sheets("Statistics").Cells(2, 27) = Val(lblRecursiveCPUUsage)
        Sheets("Statistics").Cells(2, 28) = Val(lblOtherCPU)
        Sheets("Statistics").Cells(2, 29) = Format((dblBackgroundCPU - dblBackgroundCPULast) / 1000000, "0.00")

        Sheets("Statistics").Range("B2:AC2").NumberFormat = "0.00"
    End If

Scroll down toward the end of the UpdateDisplay subroutine and locate the following line:

Sheets("Wait Events").Cells(intLastWaitClassRow, 2).Value = Format(sglWaitClassTime / 100, "0.00")

Immediately after the above line, add the following lines of code:

                    'Added in Article 6
                    'Add wait events to statistics worksheet
                    If dblDBTimeLast > 0 Then
                        Select Case UCase(strLastWaitClass)
                            Case "ADMINISTRATIVE"
                                Sheets("Statistics").Cells(2, 2) = Format(sglWaitClassTime / 100, "0.00")
                            Case "APPLICATION"
                                Sheets("Statistics").Cells(2, 3) = Format(sglWaitClassTime / 100, "0.00")
                            Case "COMMIT"
                                Sheets("Statistics").Cells(2, 4) = Format(sglWaitClassTime / 100, "0.00")
                            Case "CONCURRENCY"
                                Sheets("Statistics").Cells(2, 5) = Format(sglWaitClassTime / 100, "0.00")
                            Case "CONFIGURATION"
                                Sheets("Statistics").Cells(2, 6) = Format(sglWaitClassTime / 100, "0.00")
                            Case "NETWORK"
                                Sheets("Statistics").Cells(2, 7) = Format(sglWaitClassTime / 100, "0.00")
                            Case "OTHER"
                                Sheets("Statistics").Cells(2, 8 ) = Format(sglWaitClassTime / 100, "0.00")
                            Case "SYSTEM I/O"
                                Sheets("Statistics").Cells(2, 9) = Format(sglWaitClassTime / 100, "0.00")
                            Case "USER I/O"
                                Sheets("Statistics").Cells(2, 10) = Format(sglWaitClassTime / 100, "0.00")
                        End Select
                    End If

Run the frmTimeModel UserForm by pressing the F5 key on the keyboard.  If the code is working correctly, the Wait Events worksheet should update just as it had in the past:

You should also find that the Statistics worksheet now shows running delta values of the various statistics, with the most recent delta values on the second row of the worksheet:

One of the advantages of using Excel for the charts is that the charts automatically update as new data is added to the Statistics worksheet.  Unfortunately, the data series range for the chart is also auto-modified every time a new row is inserted into the Statistics worksheet, such that the charts never actually show any information.  To avoid this situation, the above code does not perform a row insert, rather it copies the existing data and pastes that data one row down in the worksheet.

The generated Charts worksheet should contain four charts, as shown below:

The chart formatting shown above is quite fancy – so fancy that it requires Microsoft Excel 2007 or later.  The chart creation code may be altered to create the typical flat single color chart elements found in Excel 2003 and earlier.

Are we done yet?  Your Excel worksheet contents are probably flickering quite a bit as additional data is added to the various worksheets.  To correct that problem, switch back to the window that allows seeing the source code for the UserForm and again locate the UpdateDisplay subroutine.  Locate the following line of code:

On Error Resume Next

Just above that line of code, add the following, which will tell Excel not to try updating the worksheet contents as displayed on screen until ScreenUpdating is re-enabled:

Application.ScreenUpdating = False

Scroll down to the last line of the UpdateDisplay subroutine.  Immediately after the last line (intActivated = True), add the following line:

Application.ScreenUpdating = True

——————–

Are we done yet?  Part 7 of this blog article series is still a very rough sketch.  Any ideas for improvement?





The New Order Oracle Coding Challenge 3 – Mind Boggle

5 08 2011

August 5, 2011 (Modified August 7, 2011)

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

In part 1 of this series the challenge was to simply reverse the order of digits in the numbers from 1 to 1,000,000 to find that cases where the numbers formed by the reverse ordered digits evenly divided into the original number.  In part 2 of this series the challenge required examining all of the numbers between 1000 and 9999, where arranging the digits of the original number into any of 23 valid combinations resulted in a new number that cleanly divided into the original four digit number.  There were several different solutions provided to the two challenges, so now it is time to move on to part three of the series.

In part 1 of this blog article series I mentioned playing a game years ago that used letters on the face of dice – the dice were rolled, and then the challenge was to find all words that could be completely spelled using the letters on the top of the dice.  I was not very good at the game, so I enlisted the help of a computer.  One such dice game is called Boggle, and that game’s name is probably fitting for today’s challenge.  Imagine that you played this game and the following letters appeared on the top of the dice:

One of the rules of the game requires that words must be at least 3 letters in length, for example: you say melee eye (I) see elfs file some mail (OK, the word I is too short, but we can have some fun with the words that are found).  As you might be able to guess, there are a lot of possible combinations of the 16 letters found on the dice, some of which are valid words.  If we just consider the 5 letter, 4 letter, and 3 letter combinations of the dice, there are more than a half million possible combinations (in the following table, multiply the numbers across and add the results for each row) – no wonder I needed the computer’s help with these puzzles.

16 15 14 13 12   = 16! / 11!
16 15 14 13     = 16! / 12!
16 15 14       = 16! / 13!
            = 571,200

To make the full challenge of finding words a little easier, let’s break the challenge into a couple of parts:

 Part 1: Consider the 2 x 2 letter arrangement at the left.  With the help of Oracle Database, list all of the three letter combinations of those four letters.  There will be 4 * 3 * 2 = 24 possible combinations of the letters.

 

 

 Part 2: Consider the 4 x 4 letter arrangement at the left.  With the help of Oracle Database, list all of the four letter combinations of those 16 letters.  There will be 16 * 15 * 14 * 13 = 43,680 possible combinations of the letters.

-

-

-

-

-

Part 3: Consider the 4 x 4 letter arrangement above.  With the help of Oracle Database, list all of the three, four, five, and six letter combinations of those 16 letters.  If you see any seven letter words in the above set of letters, you might as well retrieve those letter combinations also.  How many letter combinations do you have in total for part 3?

Part 4: Extra Credit: How many of the letter combinations generated in part 3 above are valid U.S. or U.K. English words?  List the words.

Part 5: Extra, Extra Credit: List any words found in the letters at the left that have any connection to Oracle Corporation.  Remember that a letter can only be used as many times in a single word as it appears at the left (if you can form a word with three letter A’s that have a connection to Oracle Corp., go for it.).

-

-

-

-

-

-

-

-

-

-

-

-

-

-

Added August 7, 2011:

When I put together this challenge I did not think that it was possible to complete Part 4 Extra Credit using just SQL.  I was fairly certain that there were some interesting techniques to retrieve HTML content with the help of PL/SQL, but I had not worked out a solution that utilized that technique.  As I write this, Radoslav Golian in the comments section appears to have both a PL/SQL and a SQL solution that uses the dictionary.reference.com website to validate the words (only 6 words to avoid a denial of service type attack on the dictionary.reference.com website).  One of the approaches that I considered, but did not develop, is something similar to how Radoslav verified the words, but I would use a VBS script to submit the request and check the result as is demonstrated in these two articles: Submit Input to an ASP Web Page and Retrieve the Result using VBS and Use VBS to Search for Oracle Books using Google’s Book Library.

The solution that I put together for Part 4 Extra Credit started with an Excel macro that I posted in another blog article, which was then converted to PL/SQL.  I then transformed the PL/SQL for use in this article, and generated a new Excel macro from the PL/SQL code.  The Excel macro (along with the calling code looks like this:

Sub StartBoggle()
    Call Boggle("ESOIMEFOALEUSAYE", 6, 3)
End Sub

Sub Boggle(strCharacters As String, intMaxWordLength As Integer, intMinWordLength As Integer)
    Dim i As Integer
    Dim strCharacter(20) As String
    Dim intCharacterIndex(20) As Integer
    Dim intCharacters As Integer
    Dim intCharactersMax As Integer
    Dim intCharactersMin As Integer
    Dim intNumberOfSuppliedCharacters As Integer
    Dim intAdjustmentPosition As Integer
    Dim intFlag As Integer
    Dim strOutput As String
    Dim strWords(10000) As String
    Dim intWordCount As Integer
    Dim intFilenum As Integer

    intFilenum = FreeFile
    Open "C:\Words " & strCharacters & ".txt" For Output As #intFilenum

    If intMaxWordLength = 0 Then
        intCharactersMax = Len(strCharacters)
    Else
        If intMaxWordLength <= Len(strCharacters) Then
            intCharactersMax = intMaxWordLength
        Else
            intCharactersMax = Len(strCharacters)
        End If
    End If

    If intMinWordLength = 0 Then
        intCharactersMin = 3
    Else
        If intMaxWordLength < intMinWordLength Then
            intCharactersMin = intCharactersMax
        Else
            intCharactersMin = intMinWordLength
        End If
    End If

    intNumberOfSuppliedCharacters = Len(strCharacters)

    For i = 1 To intNumberOfSuppliedCharacters
        strCharacter(i) = Mid(strCharacters, i, 1)
    Next i

    intCharacters = intCharactersMin - 1
    intWordCount = 0

    Do While intCharacters < intCharactersMax
        intCharacters = intCharacters + 1
        intAdjustmentPosition = 1
        For i = 1 To intCharacters
            intCharacterIndex(i) = i
        Next i

        Do While intAdjustmentPosition > 0
            intFlag = 0
            For i = 1 To intAdjustmentPosition - 1
                If intCharacterIndex(i) = intCharacterIndex(intAdjustmentPosition) Then
                    ' Found a duplicate index position in the other values to the left
                    intFlag = 1
                    Exit For
                End If
            Next i

            If intFlag = 1 Then
                ' Try the next index position in this element
                intCharacterIndex(intAdjustmentPosition) = intCharacterIndex(intAdjustmentPosition) + 1
            Else
                If intAdjustmentPosition = intCharacters Then
                    ' Output
                    strOutput = ""
                    For i = 1 To intCharacters
                        strOutput = strOutput & strCharacter(intCharacterIndex(i))
                    Next i

                    intFlag = 0
                    For i = intWordCount To 1 Step -1
                        If strOutput = strWords(i) Then
                            intFlag = 1
                            Exit For
                        End If
                    Next i
                    If intFlag = 0 Then
                        If Application.CheckSpelling(Word:=UCase(strOutput)) <> 0 Then
                            intWordCount = intWordCount + 1
                            strWords(intWordCount) = strOutput

                            Print #intFilenum, strOutput
                            Debug.Print strOutput
                        End If
                    End If

                    If intCharacterIndex(intAdjustmentPosition) = intNumberOfSuppliedCharacters Then
                        ' No more available values in the last position
                        intCharacterIndex(intAdjustmentPosition) = 1
                        intAdjustmentPosition = intAdjustmentPosition - 1
                        If intAdjustmentPosition > 0 Then
                            intCharacterIndex(intAdjustmentPosition) = intCharacterIndex(intAdjustmentPosition) + 1
                        End If
                    Else
                        intCharacterIndex(intAdjustmentPosition) = intCharacterIndex(intAdjustmentPosition) + 1
                    End If
                Else
                    ' No duplicate so prepare to check the next position
                    intAdjustmentPosition = intAdjustmentPosition + 1
                End If
            End If

            Do While (intAdjustmentPosition > 0) And (intCharacterIndex(intAdjustmentPosition) > intNumberOfSuppliedCharacters)
                ' Roll back one index position as many times as necessary
                intCharacterIndex(intAdjustmentPosition) = 1
                intAdjustmentPosition = intAdjustmentPosition - 1
                If intAdjustmentPosition > 0 Then
                    intCharacterIndex(intAdjustmentPosition) = intCharacterIndex(intAdjustmentPosition) + 1
                End If
            Loop ' (intAdjustmentPosition > 0) And
        Loop 'intAdjustmentPosition > 0
    Loop 'intCharacters < intCharactersMax

    Close #intFilenum
End Sub 

The Excel macro builds letter combinations that are between the minimum and maximum length, and then tests those letter combinations using the built-in dictionary that is in Excel.  I had a little bit of difficulty coming up with a way to generate the letter combinations of variable length, so I settled on a custom developed technique – I would simply keep track of the original character positions, manipulate those original character positions, and then output the corresponding characters.  The challenge is then how does one verify that the same character position is not used more than once in a single word? 

 The method that I came up with is as follows, which assumes that we are trying to build four letter words from the supplied 16 letters.  We can start with the seed combination 1,2,3,4.  The idea is to work from left to right, and then back to the left.  Every time to make it to the right, we output a word, when we make it all the way back to the left (just before the number 1 in the above), we are done.  The rules are simple:

  • Increment the number in a position, and if that number does not appear in a position to the left, move one position to the right.
  • When the maximum character number (16 in this example) is exceeded in a position, reset the number to 1, move one position to the left, and increment the value in the new position by 1.
  • In the last position the character number should be incremented as many times as necessary to reach the maximum character number – each time a potential new combination will be generated.

 But there is a problem with this approach – it does not use Oracle Database!

-

Let’s go back to the PL/SQL function from which I created the Excel function (I have not worked much with pipelined functions – so there may be one or two errors):

CREATE OR REPLACE FUNCTION BOGGLE_VAR_LENGTH(strCHARACTERS IN VARCHAR2, intMaxWordLength IN NUMBER, intMinWordLength IN NUMBER) RETURN SYS.AQ$_MIDARRAY PIPELINED
AS
  TYPE NUMBER_ARRAY IS TABLE OF NUMBER INDEX BY PLS_INTEGER;
  TYPE CHARACTER_ARRAY IS TABLE OF VARCHAR(1) INDEX BY PLS_INTEGER;
  strCharacter CHARACTER_ARRAY;
  intCharacterIndex NUMBER_ARRAY;
  intCharacters NUMBER;
  intCharactersMax NUMBER;
  intCharactersMin NUMBER;
  intNumberOfSuppliedCharacters NUMBER;
  intAdjustmentPosition NUMBER;
  intFlag NUMBER;
  intI NUMBER;
  strOutput VARCHAR2(100);
BEGIN
  IF intMaxWordLength IS NULL THEN
    intCharactersMax := LENGTH(strCHARACTERS);
  ELSE
    IF intMaxWordLength <= LENGTH(strCHARACTERS) THEN
      intCharactersMax := intMaxWordLength;
    ELSE
      intCharactersMax := LENGTH(strCHARACTERS);
    END IF;
  END IF;

  IF intMinWordLength IS NULL THEN
    intCharactersMin := 3;
  ELSE
    IF intMaxWordLength < intMinWordLength THEN
      intCharactersMin := intCharactersMax;
    ELSE
      intCharactersMin := intMinWordLength;
    END IF;
  END IF;

  intNumberOfSuppliedCharacters := LENGTH(strCHARACTERS);

  FOR I IN 1.. intNumberOfSuppliedCharacters LOOP
    strCharacter(I) := SUBSTR(strCHARACTERS, I, 1);
  END LOOP;

  intCharacters := intCharactersMin - 1;
  WHILE intCharacters < intCharactersMax LOOP
    intCharacters := intCharacters + 1;
    intAdjustmentPosition := 1;
    FOR I IN 1 .. intCharacters LOOP
      intCharacterIndex(I) := I;
    END LOOP;

    WHILE intAdjustmentPosition > 0 LOOP
      intFlag := 0;
      FOR I IN 1 .. intAdjustmentPosition - 1 LOOP
        IF intCharacterIndex(I) = intCharacterIndex(intAdjustmentPosition) Then
          -- Found a duplicate index position in the other values to the left
          intFlag := 1;
        END IF;
      END LOOP;
      IF intFlag = 1 Then
        -- Try the next index position in this element
        intCharacterIndex(intAdjustmentPosition) := intCharacterIndex(intAdjustmentPosition) + 1;
      ELSE
        IF intAdjustmentPosition = intCharacters Then
          -- Output
          strOutput := '';
          FOR i IN 1 .. intCharacters LOOP
            strOutput := strOutput || strCharacter(intCharacterIndex(i));
          END LOOP;

          PIPE ROW (strOutput);

          IF intCharacterIndex(intAdjustmentPosition) = intNumberOfSuppliedCharacters THEN
            -- No more available values in the last position
            intCharacterIndex(intAdjustmentPosition) := 1;
            intAdjustmentPosition := intAdjustmentPosition - 1;
            IF intAdjustmentPosition > 0 THEN
              intCharacterIndex(intAdjustmentPosition) := intCharacterIndex(intAdjustmentPosition) + 1;
            END IF;
          ELSE
            intCharacterIndex(intAdjustmentPosition) := intCharacterIndex(intAdjustmentPosition) + 1;
          END IF;
        ELSE
          -- No duplicate so prepare to check the next position
          intAdjustmentPosition := intAdjustmentPosition + 1;
        END IF;
      END IF;

      WHILE (intAdjustmentPosition > 0) And (intCharacterIndex(intAdjustmentPosition) > intNumberOfSuppliedCharacters) LOOP
        -- Roll back one index position as many times as necessary
        intCharacterIndex(intAdjustmentPosition) := 1;
        intAdjustmentPosition := intAdjustmentPosition - 1;
        IF intAdjustmentPosition > 0 THEN
          intCharacterIndex(intAdjustmentPosition) := intCharacterIndex(intAdjustmentPosition) + 1;
        END IF;
      END LOOP;
    END LOOP;
  END LOOP;
END;
/ 

 We are able to call the function from a SQL statement like this:

SELECT
  *
FROM
  TABLE(BOGGLE_VAR_LENGTH('ESOIMEFOALEUSAYE', 6, 3)); 

Remember that there are more than a half million character combinations for just the 3, 4, and 5 letter combinations – the above will as for 6,336,960 letter combinations to be generated.   But there is a problem with this approach – it does not verify that the letter combinations are actual words!

For fun, let’s see how many possible combinations will result if we allow 3, 4, 5, 6, 7, and 8 letter combinations:

Len                 Combinations  
8 16 15 14 13 12 11 10 9 518,918,400 = 16! / 8!
7 16 15 14 13 12 11 10   57,657,600 = 16! / 9!
6 16 15 14 13 12 11     5,765,760 = 16! / 10!
5 16 15 14 13 12       524,160 = 16! / 11!
4 16 15 14 13         43,680 = 16! / 12!
3 16 15 14           3,360 = 16! / 13!
                  582,912,960 582,912,960

That is more than a half billion combinations!  Warning, significant database server CPU consumption will result when generating all combinations.

Let’s take a look at the final solution that I created for Part 4 Extra, Extra Credit.  The solution is an Excel macro that calls the PL/SQL function through a SQL statement:

Sub StartBoggleOracle()
    Call BoggleOracle("ESOIMEFOALEUSAYE", 8, 3)
End Sub

Sub BoggleOracle(strCharacters As String, intMaxWordLength As Integer, intMinWordLength As Integer)
    Dim strSQL As String
    Dim strUsername As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim intFilenum As Integer

    Dim intCharacters As Integer
    Dim intCharactersMax As Integer
    Dim intCharactersMin As Integer
    Dim strOutput As String

    Dim dbDatabase As ADODB.Connection
    Dim snpData As ADODB.Recordset

    Set dbDatabase = New ADODB.Connection
    Set snpData = New ADODB.Recordset

    strUsername = "MyUsername"
    strPassword = "MyPassword"
    strDatabase = "MyDatabase"

    dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & ";FetchSize=5000;"
    dbDatabase.Open

    intFilenum = FreeFile
    Open "C:\WordsOracle " & strCharacters & ".txt" For Output As #intFilenum

    If intMaxWordLength = 0 Then
        intCharactersMax = Len(strCharacters)
    Else
        If intMaxWordLength <= Len(strCharacters) Then
            intCharactersMax = intMaxWordLength
        Else
            intCharactersMax = Len(strCharacters)
        End If
    End If

    If intMinWordLength = 0 Then
        intCharactersMin = 3
    Else
        If intMaxWordLength < intMinWordLength Then
            intCharactersMin = intCharactersMax
        Else
            intCharactersMin = intMinWordLength
        End If
    End If

    strSQL = "SELECT DISTINCT" & vbCrLf
    strSQL = strSQL & "  *" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  (SELECT" & vbCrLf
    strSQL = strSQL & "    *" & vbCrLf
    strSQL = strSQL & "  FROM" & vbCrLf
    strSQL = strSQL & "    TABLE(BOGGLE_VAR_LENGTH('" & strCharacters & "', " & Format(intCharactersMax) & ", " & Format(intCharactersMin) & ")))" & vbCrLf
    strSQL = strSQL & "ORDER BY" & vbCrLf
    strSQL = strSQL & "  1"
    snpData.Open strSQL, dbDatabase

    If snpData.State = 1 Then
        Do While Not snpData.EOF
            strOutput = snpData(0)
            If Application.CheckSpelling(Word:=UCase(strOutput)) <> 0 Then
                Print #intFilenum, strOutput
                Debug.Print strOutput
            End If

            snpData.MoveNext
        Loop

        snpData.Close
    End If

    Close #intFilenum
    dbDatabase.Close
    Set snpData = Nothing
    Set dbDatabase = Nothing
End Sub

The words found appear to depend on the version of Excel – Excel 2010 seems to find more words than Excel 2007.

  • The 799 word list from Excel 2007 for word lengths between 3 and 8 characters, including the timing information to show when the SQL statement was submitted, when the first 5,000 combinations were retrieved from the database, and when the Excel spell check finished.  Words Oracle_ESOIMEFOALEUSAYE.txt
  • The 2,179 word list from Excel 2007 for word lengths between 3 and 8 characters, including the timing information to show when the SQL statement was submitted, when the first 5,000 combinations were retrieved from the database, and when the Excel spell check finished. Words Oracle_OSERIEFAARLNCAYL.txt

Excel found Ellison in the second word list.  For Part 5 Extra, Extra Credit, what other words connected to Oracle Corporation were found?





Oracle Database Time Model Viewer in Excel 5

16 03 2011

March 16, 2011 (Updated August 11, 2011)

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

In the previous articles in this series we looked at ways to analyze the Oracle time model data at the system-wide level with drill-down into the session level detail, with cross references to a handful of statistics found in V$OSSTAT and V$SYSSTAT, and the system-wide wait events with drill-down into the session level wait event detail.  There is a chance that some of the statistics might appear to be inconsistent between the various performance views, or possibly even between the start of the retrieval of the rows from a single performance view and the retrieval of the final row from the query of that performance view.  You might even find in some cases, with some combinations of operating system platform and Oracle release version that the statistics in V$OSSTAT might not be in the unit of measure described in the Oracle Database documentation – a recent thread on the OTN forums contains an example of such a case (I completely overlooked the inconsistency that was pointed out in that thread).  Is there a reason for the inconsistency?  A quick browse through Metalink (MOS) finds the following articles:

Bug 7430365: INCORRECT VALUES FOR USER_TIME IN V$OSSTAT (3.79 hours per CPU per elapsed hour)
Bug 3574504: INCORRECT STATISTICS IN V$OSSTAT IN HP-UX
Bug 5933195: NUM_CPUS VALUE IN V$OSSTAT IS WRONG
Bug 5639749: CPU_COUNT NOT SHOWN PROPERLY FROM THE DATABASE
Bug 10427553: HOW DOES V$OSSTAT GET IT’S INFORMATION ON AIX
Bug 9228541: CPU TIME REPORTED INCORRECTLY IN V$SYSMETRIC_HISTORY (3.75 hours per CPU per elapsed hour)
Doc ID 889396.1: Very large value for OS_CPU_WAIT_TIME FROM V$OSSTAT / AWR Report
Bug 7447648: OS_CPU_WAIT_TIME VALUE FROM V$OSSTAT IS INCORRECT

At the end of the previous article, we had produced a demonstration project that generated screen output similar to the following (note that the project code as of the end of part four in the series may be downloaded by using the link at the end of the fourth article):

Let’s continue adding features to the project.  We will start by adding three new CommandButtons to the UserForm with the (Name) property set to the following (one name per CommandButton): cmdTraceSession, cmdStopTrace, and cmdShowExecutionPlan.  Assign useful titles to the CommandButtons by setting appropriate values for the Caption property – due to limited available space on the UserForm I selected the Captions: Trace, Stop Trace, and XPLAN.  The UserForm in my sample project currently appears as shown in the following screen capture:

Next, we need to add a little more code to the Initialize event of the UserForm to add the SQL statements that will allow the CommandButtons to function.  Double-click in the background area of the UserForm to display the Initialize event code for the UserForm.

Scroll down through the code until you find the following comment section:

    'More code will be copied here
    '
    '
    '

Add a couple of blank lines above that comment section and paste in the following code:

    Set snpSQLStats = New ADODB.Recordset
    Set comSQLStats = New ADODB.Command

    With comTrace
        strSQL = "DBMS_MONITOR.SESSION_TRACE_ENABLE(?,?,TRUE,TRUE)"

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

    With comXPLAN
        strSQL = "SELECT * FROM TABLE(DBMS_XPLAN.DISPLAY_CURSOR( ?, ?, 'TYPICAL +PEEKED_BINDS'))"

        'Add the bind variables
        .Parameters.Append .CreateParameter("sqlid", adVarChar, adParamInput, 40, "")
        .Parameters.Append .CreateParameter("childnumber", adNumeric, adParamInput, 8, 0)

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

    With comSQLChildReason
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  SSC.*" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SQL_SHARED_CURSOR SSC" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  SSC.SQL_ID= ?" & vbCrLf
        strSQL = strSQL & "  AND SSC.CHILD_NUMBER= ?" & vbCrLf

        'Set up the command properties
        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30

        .ActiveConnection = dbDatabase

        'Add the bind variables
        .Parameters.Append .CreateParameter("sqlid", adVarChar, adParamInput, 40, "")
        .Parameters.Append .CreateParameter("childnumber", adNumeric, adParamInput, 8, 0)
    End With

    With comSQLChildBind
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  SBM.POSITION," & vbCrLf
        strSQL = strSQL & "  SBM.DATATYPE," & vbCrLf
        strSQL = strSQL & "  SBM.MAX_LENGTH," & vbCrLf
        strSQL = strSQL & "  SBM.BIND_NAME" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SQL S," & vbCrLf
        strSQL = strSQL & "  V$SQL_BIND_METADATA SBM" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  S.SQL_ID= ?" & vbCrLf
        strSQL = strSQL & "  AND S.CHILD_NUMBER= ?" & vbCrLf
        strSQL = strSQL & "  AND S.CHILD_ADDRESS=SBM.ADDRESS" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  SBM.POSITION" & vbCrLf

        'Set up the command properties
        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30

        .ActiveConnection = dbDatabase

        'Add the bind variables
        .Parameters.Append .CreateParameter("sqlid", adVarChar, adParamInput, 40, "")
        .Parameters.Append .CreateParameter("childnumber", adNumeric, adParamInput, 8, 0)
    End With

    Set snpSQLStats = New ADODB.Recordset
    Set comSQLStats = New ADODB.Command

    With comSQLStats
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  LAST_ACTIVE_TIME," & vbCrLf
        strSQL = strSQL & "  PARSE_CALLS," & vbCrLf
        strSQL = strSQL & "  EXECUTIONS," & vbCrLf
        strSQL = strSQL & "  CPU_TIME," & vbCrLf
        strSQL = strSQL & "  ELAPSED_TIME," & vbCrLf
        strSQL = strSQL & "  APPLICATION_WAIT_TIME," & vbCrLf
        strSQL = strSQL & "  CONCURRENCY_WAIT_TIME," & vbCrLf
        strSQL = strSQL & "  CLUSTER_WAIT_TIME," & vbCrLf
        strSQL = strSQL & "  USER_IO_WAIT_TIME," & vbCrLf
        strSQL = strSQL & "  PLSQL_EXEC_TIME," & vbCrLf
        strSQL = strSQL & "  JAVA_EXEC_TIME," & vbCrLf
        strSQL = strSQL & "  BUFFER_GETS," & vbCrLf
        strSQL = strSQL & "  DISK_READS," & vbCrLf
        strSQL = strSQL & "  DIRECT_WRITES," & vbCrLf
        strSQL = strSQL & "  ROWS_PROCESSED," & vbCrLf
        strSQL = strSQL & "  FETCHES," & vbCrLf
        strSQL = strSQL & "  LOADS," & vbCrLf
        strSQL = strSQL & "  INVALIDATIONS" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SQLSTATS" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  SQL_ID= ?" & vbCrLf
        strSQL = strSQL & "  AND PLAN_HASH_VALUE= ?"
        'Set up the command properties
        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30

        .ActiveConnection = dbDatabase

        'Add the bind variables
        .Parameters.Append .CreateParameter("sqlid", adVarChar, adParamInput, 40, "")
        .Parameters.Append .CreateParameter("plan_hash_value", adNumeric, adParamInput, 8, 0)
    End With

In the above, you might have noticed that I neglected to set up the two bind variables for the comTrace object (an object of type ADODB.Command), while I did set up the two bind variables for the comXPLAN object.  The reason for this omission is that in previous testing I simply could not make the SQL code execute with bind variables, so I cheated a bit, and will simply replace the CommandText property value for the comTrace object with hardcoded values for the session’s SID and SERIAL# when the cmdTraceSession CommandButton is clicked.

View the UserForm again (find frmTimeModel under the Forms heading, right-click the UserForm’s name, and select View Object).  Then double-click the cmdTraceSession CommandButton to show the Click event for that object.  Change the Click event so that it includes the following code:

Private Sub cmdTraceSession_Click()
    Dim i As Integer
    Dim intSessionTrace As Integer
    Dim strSQL As String

    If intCurrentSessionIndex > -1 Then
        strSQL = "DBMS_MONITOR.SESSION_TRACE_ENABLE(" & Format(lngSID(intCurrentSessionIndex)) & "," & Format(lngSerial(intCurrentSessionIndex)) & " ,TRUE,TRUE)"
        comTrace.CommandText = strSQL
        comTrace.Execute
    End If

    'Remember that we enabled trace for this session
    intSessionTrace = 0
    For i = 1 To 1000
        If SessionTrace(i).lngSID = lngSID(intCurrentSessionIndex) Then
            intSessionTrace = i
            Exit For
        End If
    Next i
    If intSessionTrace = 0 Then
        'Find an unused entry
        For i = 1 To 1000
            If SessionTrace(i).lngSID = 0 Then
                intSessionTrace = i
                SessionTrace(i).lngSID = lngSID(intCurrentSessionIndex)
                SessionTrace(i).lngSerial = lngSerial(intCurrentSessionIndex)
                Exit For
            End If
        Next i
    End If
    SessionTrace(intSessionTrace).int10046Level = 12
    cmdStopTrace.Enabled = True
    cmdTraceSession.Enabled = False
    tvTimeModel.SetFocus 
End Sub

If you examine the code, you will see that we use the intCurrentSessionIndex variable’s value to know which session is the session of interest, and then set the SessionTrace object’s int10046Level property to 12 to indicate that we have enabled a level 12 trace for the session (this allows us to remember which sessions are being traced).  But, we have a couple of problems: the intCurrentSessionIndex variable has a default value of 0 and so far we have not added code to assign a value to that variable; secondly, the SessionTrace object simply does not exist.  Adding the SessionTrace object is easy, so we will start there.  Scroll all the way up to the top of the project’s code and add the following code above everything else:

Private Type TraceDefinition
    lngSID As Long
    lngSerial As Long
    int10046Level As Integer
    int10053Level As Integer
    int10032Level As Integer
    int10033Level As Integer
    int10104Level As Integer
End Type

Dim SessionTrace(1000) As TraceDefinition

The first of the above sections creates the definition of the object type TraceDefinition which is simply composed of seven variables.

While in that section of the project code, add a couple of more variable declarations that will be used later (first scroll down to where you see similar variable declarations):

Dim snpSQLStats As ADODB.Recordset          'ADO recordset object used to retrieve the statistics for the execution plan
Dim comSQLStats As ADODB.Command            'ADO command object used to retrieve the statistics for the execution plan

The second section (beginning with the word Dim) creates an array of 1,000 (actually 1,001) objects of type TraceDefinition.

Now for the hard part – how do we know which session is the current session – the one that is currently highlighted in the TreeView control?  The key to this is in how we named the TreeView rows (by setting the Key property) as the rows were added in the UpdateDisplay subroutine.  Each row that contains session-level detail has a Key property that begins with the value SESSION, so we are able to easily determine when a session-level detail row is clicked.  Also part of the Key property is an underscore ( _ ) character that acts as a field delimiter between the rest of the name and a sequential number that points to additional information about that session.  View the UserForm object again and double-click the TreeView control.  Switch to the NodeClick event for the TreeView control (in the drop-down list at the right of the code window) and change the NodeClick event’s code to show the following:

Private Sub tvTimeModel_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim i As Integer
    Dim intSessionTrace As Integer

    If Left(Node.Key, 7) = "SESSION" Then
        intCurrentSessionIndex = Right(Node.Key, Len(Node.Key) - InStr(Node.Key, "_"))

        intSessionTrace = 0
        For i = 1 To 1000
            If (SessionTrace(i).lngSID = lngSID(intCurrentSessionIndex)) And (SessionTrace(i).lngSerial = lngSerial(intCurrentSessionIndex)) Then
                intSessionTrace = i
                Exit For
            End If
        Next i
        If intSessionTrace > 0 Then
            If SessionTrace(intSessionTrace).int10046Level > 0 Then
                cmdTraceSession.Enabled = False
                cmdStopTrace.Enabled = True
            Else
                cmdTraceSession.Enabled = True
                cmdStopTrace.Enabled = False
            End If
        Else
            cmdTraceSession.Enabled = True
            cmdStopTrace.Enabled = False
        End If
        If strSQLID(intCurrentSessionIndex) <> "" Then
            cmdShowExecutionPlan.Enabled = True
        Else
            cmdShowExecutionPlan.Enabled = False
        End If
    Else
        intCurrentSessionIndex = -1
        cmdTraceSession.Enabled = False
        cmdStopTrace.Enabled = False
        cmdShowExecutionPlan.Enabled = False
    End If
End Sub

Easy to understand so far?  Let’s add the code to the cmdStopTrace CommandButton.  View the UserForm and then double-click the cmdStopTrace CommandButton.  Change the Click event’s code to show the following:

Private Sub cmdStopTrace_Click()
    Dim i As Integer
    Dim intSessionTrace As Integer
    Dim strSQL As String

    If intCurrentSessionIndex > -1 Then
        strSQL = "DBMS_MONITOR.SESSION_TRACE_DISABLE(" & Format(lngSID(intCurrentSessionIndex)) & "," & Format(lngSerial(intCurrentSessionIndex)) & ")"
        comTrace.CommandText = strSQL
        comTrace.Execute

        'Remember that we disabled trace for this session
        intSessionTrace = 0
        For i = 1 To 1000
            If SessionTrace(i).lngSID = lngSID(intCurrentSessionIndex) Then
                intSessionTrace = i
                Exit For
            End If
        Next i
        If intSessionTrace <> 0 Then
            SessionTrace(intSessionTrace).int10046Level = 0
            If (SessionTrace(intSessionTrace).int10032Level = 0) _
              And (SessionTrace(intSessionTrace).int10033Level = 0) _
              And (SessionTrace(intSessionTrace).int10046Level = 0) _
              And (SessionTrace(intSessionTrace).int10053Level = 0) _
              And (SessionTrace(intSessionTrace).int10104Level = 0) Then
                'Forget this trace entry
                SessionTrace(intSessionTrace).lngSID = 0
                SessionTrace(intSessionTrace).lngSerial = 0
            End If
        End If
        cmdStopTrace.Enabled = False
        cmdTraceSession.Enabled = True
    End If
    tvTimeModel.SetFocus
End Sub

You might notice that the code to stop the trace for a session is very similar to the code to start the trace.

The code for the cmdShowExecutionPlan CommandButton could be quite tame, as it was in the original Time Model Viewer project, but that would be a bit boring.  Let’s do something a little special.  First, view the UserForm object and then double-click the cmdShowExecutionPlan CommandButton.  Change the Click event for the CommandButton to show the following:

Private Sub cmdShowExecutionPlan_Click()
    Dim strOut As String
    Dim strSQLSQLID As String
    Dim intSQLChildNumber As Integer
    Dim intFileNum As Integer
    Dim intFlag As Integer
    Dim j As Integer

    On Error Resume Next

    tvTimeModel.SetFocus
    If intCurrentSessionIndex > -1 Then
        strSQLSQLID = Left(strSQLID(intCurrentSessionIndex), InStr(strSQLID(intCurrentSessionIndex), "/") - 1)
        intSQLChildNumber = Val(Right(strSQLID(intCurrentSessionIndex), Len(strSQLID(intCurrentSessionIndex)) - InStr(strSQLID(intCurrentSessionIndex), "/")))

        comXPLAN("sqlid") = strSQLSQLID
        comXPLAN("childnumber") = Null
        'If you only want the plan for the current SQL statement, uncomment the following
        'comXPLAN("childnumber") = intSQLChildNumber

        Set snpXPLAN = comXPLAN.Execute
        If Not (snpXPLAN Is Nothing) Then
            If snpXPLAN.State = 1 Then
                'Create the directory if it does not already exist
                If Len(Dir("C:\ExcelTimeModelViewer", vbDirectory)) < 5 Then
                    MkDir "C:\ExcelTimeModelViewer"
                End If

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

                If snpXPLAN.EOF = True Then
                    strOut = "No Execution Plans for SQL ID " & strSQLSQLID
                Else
                    strOut = ""
                End If
                Do While Not snpXPLAN.EOF
                    If (Left(snpXPLAN(0), 7) = "SQL_ID ") And (InStr(LCase(snpXPLAN(0)), "child number ") > 1) And (InStr(LCase(snpXPLAN(0)), "cannot be found") = 0) Then
                        If intFlag = True Then
                            strOut = strOut & String(100, "~") & vbCrLf
                            strOut = strOut & "" & vbCrLf
                            intFlag = False
                        End If
                        strOut = strOut & String(100, "*") & vbCrLf
                        comSQLChildReason("sqlid") = strSQLSQLID
                        comSQLChildReason("childnumber") = CInt(Right(snpXPLAN(0), Len(snpXPLAN(0)) - (InStr(snpXPLAN(0), "child number ") + 12)))
                        Set snpSQLChildReason = comSQLChildReason.Execute

                        If Not (snpSQLChildReason Is Nothing) Then
                            If snpSQLChildReason.State = 1 Then
                                If Not (snpSQLChildReason.EOF) Then
                                    strOut = strOut & "Reason for Child Cursor Creation" & vbCrLf
                                    For j = 4 To snpSQLChildReason.Fields.Count - 1
                                        If snpSQLChildReason(j) = "Y" Then
                                            strOut = strOut & snpSQLChildReason.Fields(j).Name & "" & vbCrLf
                                        End If
                                    Next j
                                    strOut = strOut & "**********" & vbCrLf
                                End If
                                snpSQLChildReason.Close
                            End If
                        End If

                        comSQLChildBind("sqlid") = strSQLSQLID
                        comSQLChildBind("childnumber") = CInt(Right(snpXPLAN(0), Len(snpXPLAN(0)) - (InStr(snpXPLAN(0), "child number ") + 12)))
                        Set snpSQLChildBind = comSQLChildBind.Execute

                        If Not (snpSQLChildBind Is Nothing) Then
                            If snpSQLChildBind.State = 1 Then
                                If Not (snpSQLChildBind.EOF) Then
                                    strOut = strOut & "Bind Variable Definitions" & vbCrLf
                                    Do While Not (snpSQLChildBind.EOF)
                                        strOut = strOut & "  Position:" & CStr(snpSQLChildBind("position"))
                                        strOut = strOut & "  Max Length:" & CStr(snpSQLChildBind("max_length"))
                                        Select Case snpSQLChildBind("datatype")
                                          Case 1
                                              strOut = strOut & "  VARCHAR2"
                                          Case 2
                                              strOut = strOut & "  NUMBER"
                                          Case 8
                                              strOut = strOut & "  LONG"
                                          Case 11
                                              strOut = strOut & "  ROWID"
                                          Case 12
                                              strOut = strOut & "  DATE"
                                          Case 23
                                              strOut = strOut & "  RAW"
                                          Case 24
                                              strOut = strOut & "  LONG RAW"
                                          Case 96
                                              strOut = strOut & "  CHAR"
                                          Case 112
                                              strOut = strOut & "  CLOB"
                                          Case 113
                                              strOut = strOut & "  BLOB"
                                          Case 114
                                              strOut = strOut & "  BFILE"
                                          Case Else
                                              strOut = strOut & "  TYPE " & CStr(snpSQLChildBind("datatype"))
                                        End Select
                                        strOut = strOut & "  Name:" & snpSQLChildBind("bind_name")
                                        strOut = strOut & "" & vbCrLf

                                        snpSQLChildBind.MoveNext
                                    Loop
                                    strOut = strOut & "**********" & vbCrLf
                                End If
                                snpSQLChildBind.Close
                            End If
                        End If
                    End If

                    If InStr(UCase(snpXPLAN(0)), "PLAN HASH VALUE:") = 1 Then
                        'Found the PLAN_HASH_VALUE
                        comSQLStats("sqlid") = strSQLSQLID
                        comSQLStats("plan_hash_value") = Val(Right(snpXPLAN(0), Len(snpXPLAN(0)) - InStr(snpXPLAN(0), ":")))
                        Set snpSQLStats = comSQLStats.Execute

                        If Not (snpSQLStats Is Nothing) Then
                            If snpSQLStats.State = 1 Then
                                If Not (snpSQLStats.EOF) Then
                                    If snpSQLStats("executions") > 0 Then
                                        strOut = strOut & "" & vbCrLf
                                        strOut = strOut & "Statistics for Execution Plan:" & vbCrLf
                                        strOut = strOut & "  Last Active: " & snpSQLStats("last_active_time") & vbCrLf
                                        strOut = strOut & "  Parses:                " & Format(Format(snpSQLStats("parse_calls"), "#,##0   "), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Executions:            " & Format(Format(snpSQLStats("executions"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Exec Per Parse: " & Format(Format(snpSQLStats("executions") / snpSQLStats("parse_calls"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  CPU Time:              " & Format(Format(snpSQLStats("cpu_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("cpu_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Elapsed Time:          " & Format(Format(snpSQLStats("elapsed_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("elapsed_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Application Wait Time: " & Format(Format(snpSQLStats("application_wait_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("application_wait_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Concurrency Wait Time: " & Format(Format(snpSQLStats("concurrency_wait_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("concurrency_wait_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  User IO Wait Time:     " & Format(Format(snpSQLStats("user_io_wait_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("user_io_wait_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Application Wait Time: " & Format(Format(snpSQLStats("application_wait_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("application_wait_time") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Cluster Wait Time:     " & Format(Format(snpSQLStats("cluster_wait_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("cluster_wait_time") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  PL/SQL Execute Time:   " & Format(Format(snpSQLStats("plsql_exec_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("plsql_exec_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Java Execution Time:   " & Format(Format(snpSQLStats("java_exec_time") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("java_exec_time") / snpSQLStats("executions") / 1000000, "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Buffer (Cons.) Gets:   " & Format(Format(snpSQLStats("buffer_gets"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("buffer_gets") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Disk (Block) Reads:    " & Format(Format(snpSQLStats("disk_reads"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("disk_reads") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Direct Writes:         " & Format(Format(snpSQLStats("direct_writes"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("direct_writes") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Rows Processed:        " & Format(Format(snpSQLStats("rows_processed"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("rows_processed") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Fetches:               " & Format(Format(snpSQLStats("fetches"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("fetches") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Loads:                 " & Format(Format(snpSQLStats("loads"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("loads") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf
                                        strOut = strOut & "  Invalidations:         " & Format(Format(snpSQLStats("invalidations"), "#,##0   "), "@@@@@@@@@@@@@@") _
                                            & "    Per Exec:       " & Format(Format(snpSQLStats("invalidations") / snpSQLStats("executions"), "#,##0.00"), "@@@@@@@@@@@@@@") & vbCrLf

                                        strOut = strOut & "" & vbCrLf
                                    End If
                                End If
                                snpSQLStats.Close
                            End If
                        End If
                    End If

                    If (InStr(snpXPLAN(0), "SQL_ID") > 0) And (InStr(snpXPLAN(0), "child number " & Format(intSQLChildNumber)) > 0) Then
                        intFlag = True
                        strOut = strOut & "Plan Used by the Session" & vbCrLf
                        strOut = strOut & String(100, "~") & vbCrLf
                        strOut = strOut & snpXPLAN(0) & vbCrLf
                        strOut = strOut & String(100, "~") & vbCrLf
                    Else
                        strOut = strOut & snpXPLAN(0) & vbCrLf
                    End If

                    snpXPLAN.MoveNext
                Loop
                snpXPLAN.Close
                If intFlag = True Then
                    strOut = strOut & String(100, "~") & vbCrLf
                End If
                strOut = strOut & vbCrLf
            End If
        End If

        Print #intFileNum, strOut
        Close #intFileNum
        Shell "notepad.exe C:\ExcelTimeModelViewer\DBMS_XPLAN.txt", vbNormalFocus
    End If
End Sub

Note that in the above code, if you are running Windows Vista or Window 7 with User Access Control enabled, you will need to replace all instances of C:\ExcelTimeModelViewer in the code with a writeable file location.

Press the F5 key to start up the execution of the UserForm.  You might need to toggle the chkPauseFresh CheckBox to allow the UserForm data to begin updating.  Just as an experiment, I decided to take a look at the execution plan for the SQL_ID that was identified for my Excel session.  The following is the output that was displayed on screen (in the Notepad application window):

****************************************************************************************************
Reason for Child Cursor Creation
**********
Plan Used by the Session
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SQL_ID  6uw0vzxdsd8f8, child number 0
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-------------------------------------
SELECT    S.SID,    S.SERIAL#,    S.STATUS,    NVL(S.USERNAME,' ')
USERNAME,    NVL(S.MACHINE,' ') MACHINE,    NVL(S.PROGRAM,' ') PROGRAM,
   NVL(S.SQL_ID,NVL(S.PREV_SQL_ID,' ')) SQL_ID,   
NVL(S.SQL_CHILD_NUMBER,NVL(S.PREV_CHILD_NUMBER,0)) SQL_CHILD_NUMBER,   
STM.VALUE,    STM.STAT_NAME  FROM    V$SESS_TIME_MODEL STM,   
V$SESSION S  WHERE    S.SID=STM.SID  ORDER BY    S.USERNAME,   
S.PROGRAM,    S.SID

Statistics for Execution Plan:
  Last Active: 3/15/2011 11:12:31 PM
  Parses:                         14  
  Executions:                     18       Exec Per Parse:           1.29
  CPU Time:                        0.06    Per Exec:                 0.00
  Elapsed Time:                    0.08    Per Exec:                 0.00
  Application Wait Time:           0.00    Per Exec:                 0.00
  Concurrency Wait Time:           0.00    Per Exec:                 0.00
  User IO Wait Time:               0.01    Per Exec:                 0.00
  Application Wait Time:           0.00    Per Exec:                 0.00
  Cluster Wait Time:               0.00    Per Exec:                 0.00
  PL/SQL Execute Time:             0.00    Per Exec:                 0.00
  Java Execution Time:             0.00    Per Exec:                 0.00
  Buffer (Cons.) Gets:           201       Per Exec:                11.17
  Disk (Block) Reads:              4       Per Exec:                 0.22
  Direct Writes:                   0       Per Exec:                 0.00
  Rows Processed:              8,170       Per Exec:               453.89
  Fetches:                        90       Per Exec:                 5.00
  Loads:                           2       Per Exec:                 0.11
  Invalidations:                   0       Per Exec:                 0.00

Plan hash value: 186343697

------------------------------------------------------------------------------------------------------------
| Id  | Operation                    | Name               | Rows  | Bytes | Cost (%CPU)| Time     | Inst   |
------------------------------------------------------------------------------------------------------------
|   0 | SELECT STATEMENT             |                    |       |       |     2 (100)|          |        |
|   1 |  SORT ORDER BY               |                    |   273 | 27846 |     2 (100)| 00:00:01 |        |
|*  2 |   HASH JOIN                  |                    |   273 | 27846 |     1 (100)| 00:00:01 |        |
|*  3 |    FIXED TABLE FULL          | X$KEWSSMAP         |    13 |   455 |     0   (0)|          |  OR112 |
|   4 |    NESTED LOOPS              |                    |  1604 |   104K|     0   (0)|          |        |
|   5 |     NESTED LOOPS             |                    |    24 |  1224 |     0   (0)|          |        |
|   6 |      NESTED LOOPS            |                    |    24 |   288 |     0   (0)|          |        |
|   7 |       FIXED TABLE FULL       | X$KSLWT            |    24 |   192 |     0   (0)|          |  OR112 |
|*  8 |       FIXED TABLE FIXED INDEX| X$KSLED (ind:2)    |     1 |     4 |     0   (0)|          |  OR112 |
|*  9 |      FIXED TABLE FIXED INDEX | X$KSUSE (ind:1)    |     1 |    39 |     0   (0)|          |  OR112 |
|* 10 |     FIXED TABLE FIXED INDEX  | X$KEWSSESV (ind:1) |    67 |  1072 |     0   (0)|          |  OR112 |
------------------------------------------------------------------------------------------------------------

Predicate Information (identified by operation id):
---------------------------------------------------

   2 - access("MAP"."SOFFST"="SESV"."KEWSNUM")
   3 - filter(("MAP"."AGGID"=1 AND INTERNAL_FUNCTION("MAP"."STYPE") AND
              "MAP"."INST_ID"=USERENV('INSTANCE')))
   8 - filter("W"."KSLWTEVT"="E"."INDX")
   9 - filter((BITAND("S"."KSUSEFLG",1)<>0 AND BITAND("S"."KSSPAFLG",1)<>0 AND
              "S"."INST_ID"=USERENV('INSTANCE') AND "S"."INDX"="W"."KSLWTSID"))
  10 - filter((BITAND("SESV"."KSUSEFLG",1)<>0 AND BITAND("SESV"."KSSPAFLG",1)<>0 AND
              "S"."INDX"="SESV"."KSUSENUM"))

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

****************************************************************************************************
Reason for Child Cursor Creation
STATS_ROW_MISMATCH
**********
SQL_ID  6uw0vzxdsd8f8, child number 1
-------------------------------------
SELECT    S.SID,    S.SERIAL#,    S.STATUS,    NVL(S.USERNAME,' ')
USERNAME,    NVL(S.MACHINE,' ') MACHINE,    NVL(S.PROGRAM,' ') PROGRAM,
   NVL(S.SQL_ID,NVL(S.PREV_SQL_ID,' ')) SQL_ID,   
NVL(S.SQL_CHILD_NUMBER,NVL(S.PREV_CHILD_NUMBER,0)) SQL_CHILD_NUMBER,   
STM.VALUE,    STM.STAT_NAME  FROM    V$SESS_TIME_MODEL STM,   
V$SESSION S  WHERE    S.SID=STM.SID  ORDER BY    S.USERNAME,   
S.PROGRAM,    S.SID

Statistics for Execution Plan:
  Last Active: 3/15/2011 11:12:31 PM
  Parses:                         14  
  Executions:                     18       Exec Per Parse:           1.29
  CPU Time:                        0.06    Per Exec:                 0.00
  Elapsed Time:                    0.08    Per Exec:                 0.00
  Application Wait Time:           0.00    Per Exec:                 0.00
  Concurrency Wait Time:           0.00    Per Exec:                 0.00
  User IO Wait Time:               0.01    Per Exec:                 0.00
  Application Wait Time:           0.00    Per Exec:                 0.00
  Cluster Wait Time:               0.00    Per Exec:                 0.00
  PL/SQL Execute Time:             0.00    Per Exec:                 0.00
  Java Execution Time:             0.00    Per Exec:                 0.00
  Buffer (Cons.) Gets:           201       Per Exec:                11.17
  Disk (Block) Reads:              4       Per Exec:                 0.22
  Direct Writes:                   0       Per Exec:                 0.00
  Rows Processed:              8,170       Per Exec:               453.89
  Fetches:                        90       Per Exec:                 5.00
  Loads:                           2       Per Exec:                 0.11
  Invalidations:                   0       Per Exec:                 0.00

Plan hash value: 186343697

------------------------------------------------------------------------------------------------------------
| Id  | Operation                    | Name               | Rows  | Bytes | Cost (%CPU)| Time     | Inst   |
------------------------------------------------------------------------------------------------------------
|   0 | SELECT STATEMENT             |                    |       |       |     2 (100)|          |        |
|   1 |  SORT ORDER BY               |                    |   273 | 27846 |     2 (100)| 00:00:01 |        |
|*  2 |   HASH JOIN                  |                    |   273 | 27846 |     1 (100)| 00:00:01 |        |
|*  3 |    FIXED TABLE FULL          | X$KEWSSMAP         |    13 |   455 |     0   (0)|          |  OR112 |
|   4 |    NESTED LOOPS              |                    |  1604 |   104K|     0   (0)|          |        |
|   5 |     NESTED LOOPS             |                    |    24 |  1224 |     0   (0)|          |        |
|   6 |      NESTED LOOPS            |                    |    24 |   288 |     0   (0)|          |        |
|   7 |       FIXED TABLE FULL       | X$KSLWT            |    24 |   192 |     0   (0)|          |  OR112 |
|*  8 |       FIXED TABLE FIXED INDEX| X$KSLED (ind:2)    |     1 |     4 |     0   (0)|          |  OR112 |
|*  9 |      FIXED TABLE FIXED INDEX | X$KSUSE (ind:1)    |     1 |    39 |     0   (0)|          |  OR112 |
|* 10 |     FIXED TABLE FIXED INDEX  | X$KEWSSESV (ind:1) |    67 |  1072 |     0   (0)|          |  OR112 |
------------------------------------------------------------------------------------------------------------

Predicate Information (identified by operation id):
---------------------------------------------------

   2 - access("MAP"."SOFFST"="SESV"."KEWSNUM")
   3 - filter(("MAP"."AGGID"=1 AND INTERNAL_FUNCTION("MAP"."STYPE") AND
              "MAP"."INST_ID"=USERENV('INSTANCE')))
   8 - filter("W"."KSLWTEVT"="E"."INDX")
   9 - filter((BITAND("S"."KSUSEFLG",1)<>0 AND BITAND("S"."KSSPAFLG",1)<>0 AND
              "S"."INST_ID"=USERENV('INSTANCE') AND "S"."INDX"="W"."KSLWTSID"))
  10 - filter((BITAND("SESV"."KSUSEFLG",1)<>0 AND BITAND("SESV"."KSSPAFLG",1)<>0 AND
              "S"."INDX"="SESV"."KSUSENUM"))

If you examine the above, you will notice that the output from V$SQLSTATS is identical for both of the child cursors – that is because the PLAN_HASH_VALUE is identical for both of the child cursors.

Where do we head next with the project?  I am a person who prefers looking at raw numbers, but maybe someone reading this blog prefers pictures?

Added August 11, 2011:

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





Oracle Database Time Model Viewer in Excel 4

6 03 2011

March 6, 2011 (Updated March 15, 2011)

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

In the previous three parts of this series we started building an Oracle Database time model statistics viewer using nothing more than Microsoft Excel.  The end result will hopefully duplicate some of the functionality that is found in a portion of a program that I have been building over the course of the last several years.  My program’s window that shows the Oracle Database time model statistics looks like this:

If you have been following along with the previous articles in this series,  at this point your Excel UserForm project should look something like the following screen capture:

We still need to add the wait events to the project.  While we could display the wait events information in a TreeView control, there would not be much sense to display the wait event information in a grid type control when we are able to just push that information out to a worksheet in the Excel workbook.  So that we are able to control which worksheet that information will be push to, we should begin by naming the worksheet.  In the main Excel window, right-click Sheet1 and select Rename.  Change the name to Wait Events.

Now switch back to the code window for the project (note that you can display the code window by right-click a worksheet tab and selecting View Code).  Right-click frmTimeModel (under the Forms heading which is below Microsoft Excel Objects) and select View Object.  The Caption property of the UserForm likely still shows UserForm1 – change the Caption property to something that is more meaningful (I will change my Caption to I Can’t Believe I Build an Oracle Database Time Model Viewer in Excel - yes, that typo is intentional).  Double-click the background of the UserForm to show the code for the UserForm’s Initialize event.  Locate the following text in the Initialize event:

    'More code will be copied here
    '
    '
    ' 

Move the cursor just above that text and press the Enter key a couple of times.  Add the following code above the ‘More code will be copied here line.  Note that the second of the SQL statements uses bind variables:

    'Added in Article 4
    With comDataWait
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  WAIT_CLASS," & vbCrLf
        strSQL = strSQL & "  EVENT," & vbCrLf
        strSQL = strSQL & "  TOTAL_WAITS," & vbCrLf
        strSQL = strSQL & "  TOTAL_TIMEOUTS," & vbCrLf
        strSQL = strSQL & "  TIME_WAITED" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SYSTEM_EVENT" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  WAIT_CLASS," & vbCrLf
        strSQL = strSQL & "  EVENT"

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

    With comSessionWait
        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 & "  SE.EVENT," & vbCrLf
        strSQL = strSQL & "  SE.TOTAL_WAITS," & vbCrLf
        strSQL = strSQL & "  SE.TOTAL_TIMEOUTS," & vbCrLf
        strSQL = strSQL & "  SE.TIME_WAITED" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SESSION_EVENT SE," & vbCrLf
        strSQL = strSQL & "  V$SESSION S" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  SE.EVENT = ?" & vbCrLf
        strSQL = strSQL & "  AND SE.SID=S.SID" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  S.SID"

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

        'Add the bind variables
        .Parameters.Append .CreateParameter("event", adVarChar, adParamInput, 40, "")
    End With 

Scroll up in the code until you locate the ReadData subroutine.  Locate the following line at the bottom of that subroutine:

dteLastLoopStart = Now

Move the cursor just above that line and press the Enter key a couple of times.  In the blank area that was just created paste the following code which will read in the system-wide wait event statistics and store those statistics in variables:

    'Added in Article 4
    Set snpDataWait = comDataWait.Execute
    If Not (snpDataWait Is Nothing) Then
        Do While Not (snpDataWait.EOF)
            intWaitCurrent = intWaitCount + 1
            'Find the previous entry for this wait event
            For j = 1 To intWaitCount
                If strWaitEventName(j) = CStr(snpDataWait("event")) Then
                    intWaitCurrent = j
                    Exit For
                End If
            Next j
            If intWaitCurrent = intWaitCount + 1 Then
                'New entry
                intWaitCount = intWaitCount + 1
                strWaitEventName(intWaitCurrent) = CStr(snpDataWait("event"))
                strWaitEventClass(intWaitCurrent) = snpDataWait("wait_class")
            End If
            dblWaitValueLast(intWaitCurrent) = dblWaitValue(intWaitCurrent)
            dblWaitValue(intWaitCurrent) = CDbl(snpDataWait("time_waited"))
            dblWaitWaitsValueLast(intWaitCurrent) = dblWaitWaitsValue(intWaitCurrent)
            dblWaitWaitsValue(intWaitCurrent) = CDbl(snpDataWait("total_waits"))
            dblWaitTOValueLast(intWaitCurrent) = dblWaitTOValue(intWaitCurrent)
            dblWaitTOValue(intWaitCurrent) = CDbl(snpDataWait("total_timeouts"))

            snpDataWait.MoveNext
        Loop
        snpDataWait.Close
    End If 

Note in the above code the snpDataWait.Close command that is below the Loop and above the End If lines.  That command closes the snpDataWait recordset, which is necessary to prevent cursor leaks.  Review the other code sections that are in the ReadData subroutine and verify that the recordset is always closed between the Loop and End If lines, and if it is not, fix that problem (hint: there is at least one code section that needs to be corrected).

Find the UpdateDisplay subroutine and locate the following line near the start of the subroutine:

On Error Resume Next 

Just above that line, press the Enter key a couple of times and add the following variable declaration – this variable will be used to control where the output is placed on the worksheet:

Dim lngRow As Long 

Scroll down to the bottom of the UpdateDisplay subroutine and locate the following line:

intCurrentSessionIndex = -1 

Move the cursor just above that line, press the Enter key a couple of times.  Paste in the following code on the blank lines:

    'Added in Article 4
    lngRow = 1
    Sheets("Wait Events").Rows("1:10000").Delete Shift:=xlUp
    Sheets("Wait Events").Cells(lngRow, 1).Value = "Wait Event Name"
    Sheets("Wait Events").Cells(lngRow, 2).Value = "Wait Time"
    Sheets("Wait Events").Cells(lngRow, 3).Value = "Waits"
    Sheets("Wait Events").Cells(lngRow, 4).Value = "Timeouts"
    Sheets("Wait Events").Cells(lngRow, 5).Value = "Session Description"

    For j = 1 To intWaitCount
        If (strWaitEventClass(j) <> "Idle") Or (intExcludeIdleWaits = False) Then
            If strLastWaitClass <> strWaitEventClass(j) Then
                If strLastWaitClass <> "" Then
                    'Do not write out on the first pass
                    Sheets("Wait Events").Cells(intLastWaitClassRow, 2).Value = Format(sglWaitClassTime / 100, "0.00")
                End If

                strLastWaitClass = strWaitEventClass(j)
                lngRow = lngRow + 1
                Sheets("Wait Events").Cells(lngRow, 1).Value = strLastWaitClass & " Wait Class"
                Sheets("Wait Events").Cells(lngRow, 1).Font.Bold = True
                Sheets("Wait Events").Cells(lngRow, 2).Font.Bold = True
                intLastWaitClassRow = lngRow
                sglWaitClassTime = 0
            End If

            If (dblWaitValue(j) - dblWaitValueLast(j)) <> 0 Then
                sglWaitClassTime = sglWaitClassTime + (dblWaitValue(j) - dblWaitValueLast(j))

                If strWaitEventClass(j) <> "Idle" Then
                    sglTotalWaitTime = sglTotalWaitTime + (dblWaitValue(j) - dblWaitValueLast(j))
                End If

                lngRow = lngRow + 1
                Sheets("Wait Events").Cells(lngRow, 1).Value = "-- " & strWaitEventName(j)
                Sheets("Wait Events").Cells(lngRow, 2).Value = Format((dblWaitValue(j) - dblWaitValueLast(j)) / 100, "0.00")
                Sheets("Wait Events").Cells(lngRow, 3).Value = Format((dblWaitWaitsValue(j) - dblWaitWaitsValueLast(j)), "0")
                Sheets("Wait Events").Cells(lngRow, 4).Value = Format((dblWaitTOValue(j) - dblWaitTOValueLast(j)), "0")
                Sheets("Wait Events").Cells(lngRow, 5).Value = ""

                If (intDisplaySessionDetail = True) Then
                    comSessionWait("event") = strWaitEventName(j)
                    Set snpSessionWait = comSessionWait.Execute

                    If Not (snpSessionWait Is Nothing) Then
                        If snpSessionWait.State = 1 Then
                            Do While Not (snpSessionWait.EOF)
                                intSessionCurrent = 0
                                For k = 1 To intSessionCount
                                    If (lngSID(k) = CLng(snpSessionWait("sid"))) And (lngSerial(k) = CLng(snpSessionWait("serial#"))) Then
                                        intSessionCurrent = k

                                        'Output the session wait information
                                        If (snpSessionWait("time_waited") - dblSessionWaitValue(j, intSessionCurrent) > 0) Then
                                            'Output only if time change is more that the sglSessionMinimumPercent value
                                            If ((CDbl(snpSessionWait("time_waited")) - dblSessionWaitValue(j, intSessionCurrent)) > 0) And (CDbl(snpSessionWait("time_waited")) - dblSessionWaitValue(j, intSessionCurrent)) / (dblWaitValue(j) - dblWaitValueLast(j)) >= sglSessionMinimumPercent Then
                                                lngRow = lngRow + 1
                                                Sheets("Wait Events").Cells(lngRow, 1).Value = "---- session level wait " & Format((CDbl(snpSessionWait("time_waited")) - dblSessionWaitValue(j, intSessionCurrent)) / (dblWaitValue(j) - dblWaitValueLast(j)), "0.00%") & " of system wait event"
                                                Sheets("Wait Events").Cells(lngRow, 2).Value = Format((CDbl(snpSessionWait("time_waited")) - dblSessionWaitValue(j, intSessionCurrent)) / 100, "0.00")
                                                Sheets("Wait Events").Cells(lngRow, 3).Value = Format((CDbl(snpSessionWait("total_waits")) - dblSessionWaitWaitsValue(j, intSessionCurrent)), "0")
                                                Sheets("Wait Events").Cells(lngRow, 4).Value = Format((CDbl(snpSessionWait("total_timeouts")) - dblSessionWaitTOValue(j, intSessionCurrent)), "0")

                                                strOut = "SID:" & Format(snpSessionWait("sid")) & " SERIAL#:" & Format(snpSessionWait("serial#"))
                                                strOut = strOut & " ~ Machine: " & snpSessionWait("machine") & " ~ " & snpSessionWait("username") & " ~ " & snpSessionWait("program")
                                                If snpSessionWait("sql_id") <> " " Then
                                                    strOut = strOut & " ~ SQL_ID/Child: " & snpSessionWait("sql_id") & "/" & Format(snpSessionWait("sql_child_number"), "0") & " "
                                                    If UCase(snpSessionWait("status")) = "ACTIVE" Then
                                                        strOut = strOut & " (A)"
                                                    End If
                                                End If
                                                Sheets("Wait Events").Cells(lngRow, 5).Value = strOut
                                            End If
                                        End If
                                        dblSessionWaitValue(j, intSessionCurrent) = CDbl(snpSessionWait("time_waited"))
                                        dblSessionWaitWaitsValue(j, intSessionCurrent) = CDbl(snpSessionWait("total_waits"))
                                        dblSessionWaitTOValue(j, intSessionCurrent) = CDbl(snpSessionWait("total_timeouts"))

                                        Exit For
                                    End If
                                Next k

                                snpSessionWait.MoveNext
                            Loop
                            snpSessionWait.Close
                        End If
                    End If
                End If
            End If
        End If
    Next j

    If strLastWaitClass <> "" Then
        Sheets("Wait Events").Cells(intLastWaitClassRow, 2).Value = Format(sglWaitClassTime / 100, "0.00")
    End If

    Sheets("Wait Events").Columns("A:A").EntireColumn.AutoFit
    Sheets("Wait Events").Columns("B:B").EntireColumn.AutoFit
    Sheets("Wait Events").Columns("C:C").EntireColumn.AutoFit
    Sheets("Wait Events").Columns("D:D").EntireColumn.AutoFit
    Sheets("Wait Events").Columns("E:E").EntireColumn.AutoFit
    Sheets("Wait Events").Columns("B:B").NumberFormat = "0.00"
    Sheets("Wait Events").Range("B2").Select
    ActiveWindow.FreezePanes = True 

'    lblTotalWaitTime = Format(sglTotalWaitTime / 100, "0.00")

You may have noticed that the chkPauseRefresh CheckBox (with caption Pause Refresh) does not work quite as expected – this is a simple logic problem that needs to be addressed.  Find the chkPauseRefresh CheckBox on the UserForm and double-click it to show the code that is behind the CheckBox control.  You will see a line of code that looks like this:

If intKillFlag <> False Then

Change the <> characters to an = character so that the line appears as follows:

If intKillFlag = False Then 

If you then show the UserForm (switch to the Initialize event of the UserForm and press the F5 key, you may then need to toggle the chkPauseRefresh check box between checked and not checked) you should see something like this after the second 60 second delay:

We still have a slight problem that needs to be addressed.  We need another Label control on the UserForm, with the name lblTotalWaitTime.  Once you have created that Label control, you can go back to the UpdateDisplay subroutine and remove the single quote (‘) that is in front of the following line:

'    lblTotalWaitTime = Format(sglTotalWaitTime / 100, "0.00") 

When the single quote is removed, the text color should change from green to black.

What more are we able to do with this project?  We could display the execution plans for the captured SQL_ID and CHILD_NUMBER (stored in the strSQLID() array), we could enable/disable 10046 tracing for sessions, we could write out the statistics in real-time to another worksheet and then graph the results, or maybe we could just sit back and stare at the screen in amazement that this project was built in Microsoft Excel ;-)

—-

Added March 15, 2011:

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





Oracle Database Time Model Viewer in Excel 3

3 03 2011

March 3, 2011 (Updated March 5, 2011)

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

In the previous articles of this series we started building a solution in Microsoft Excel that duplicates some of the functionality in one of my programs – the Oracle Database Time Model viewer.  So far, the project only works at just the system-wide level.  Hopefully, not too many people are having difficulty following along with this article series – it has been more than a decade since I professionally taught programming and Microsoft Excel, so I might be overlooking a couple of “obviously” difficult points. 

If you have not done so yet, you may need to change Excel’s default behavior when an error occurs in the code, since some errors are expected and should be handled appropriately within our programming code.  To check the error trapping setting in the Excel code editor window, select from the menu ToolsOptions.  On the General tab, find and select the setting Break on Unhandled Errors, then click the OK button.  If you plan to do much programming in Excel, I also suggest setting the Require Variable Declaration option on the Editor tab – setting that option helps to avoid some forms of typing errors (all used variables must be officially declared before use).

If you find that the macro seems to pause unexpectedly when first started, there is a simple solution for that issue, and we will apply the simple solution later in this article.

We will start by adding a couple of more controls to the UserForm to add a little more functionality to the programming code.  In my sample project I will be adding the extra controls at the top of the UserForm.  We need to add three CheckBox controls to the UserForm with the (Name) property set to: chkPauseRefresh, chkDisplaySessionDetail, and chkExcludeIdleWaits (one name for each CheckBox).  Change the Caption property of those checkboxes to describe the function of the CheckBoxes (I used: Pause Refresh, Show Session Detail, and No Idle Waits).  Add two ComboBox controls to the UserForm with the (Name) property set to: cboUpdateFrequency and cboSessionMinimumPercent.  Set the Text property of the cboUpdateFrequency ComboBox to 60.  Set the Text property of the cboSessionMinimumPercent ComboBox to 10.  Add a Label control near each of the ComboBox controls, and change the Caption property of the Label controls to describe the purpose of the ComboBox controls (I used: Update Freq (S) and Min Utilization to Inc. Session %).  Your UserForm should look something like this when finished with the above instructions:

The extra controls at this point do nothing, other than occupy space on the UserForm, so we need to add functionality to the extra controls.  Double-click the chkPauseRefresh CheckBox to show the default code event for the CheckBox – the “Click” event.  The TimerEvent subroutine that we modified in the previous article is set to abort re-executing the TimerEvent subroutine any time the intKillFlag variable is set to something other than False (a value of 0).  So, the code for the chkPauseRefresh CheckBox’s Click event will simply toggle this intKillFlag variable between the values of True and False – if the value becomes True we need to restart the re-execution of the TimerEvent procedure.  The easiest way to accomplish this task is with the following code in the chkPauseRefresh CheckBox’s Click event (note that in Visual Basic versions 4.0 through 6.0 this same code will toggle the intKillFlag variable between the values of 0 and 1, but the code as written will behave the same way.  Value is the default property of a CheckBox control, so technically we could have omitted the .Value portion of the code):

Private Sub chkPauseRefresh_Click()
    intKillFlag = chkPauseRefresh.Value

    If intKillFlag <> False Then
        TimerEvent
    End If
End Sub 

The chkDisplaySessionDetail CheckBox technically does not require any special programming code in its Click event, so we will come back to this program functionality later.

The Click event for the chkExcludeIdleWaits CheckBox is similar to that of the same event for the chkPauseRefresh CheckBox.  On the UserForm, double-click the chkExcludeIdleWaits CheckBox (or simply select that name from the left ComboBox (drop-down list) in the code editor).  Change the Click event for that CheckBox to the following:

Private Sub chkExcludeIdleWaits_Click()
    intExcludeIdleWaits = chkExcludeIdleWaits.Value
End Sub

We need to add a little code to the two ComboBox controls in order to prevent the user of this tool from entering silly values, such as Sixty for the update frequency or 1,000,000 for the minimum utilization percent – we will check the entered values only when the user “tabs” out of the controls (or clicks something else).  Double-click the cboUpdateFrequency ComboBox, then select the Exit event from the ComboBox (drop-down list) that is at the top-right of the code window.  Add the following code to that event:

Private Sub cboUpdateFrequency_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim intResult As Integer

    If IsNumeric(cboUpdateFrequency.Text) Then
        If (Val(cboUpdateFrequency.Text) >= 1) And (Val(cboUpdateFrequency.Text) <= 18000) Then
            'OK
            lngTimerTriggerSeconds = Val(cboUpdateFrequency.Text)
        Else
            intResult = MsgBox(cboUpdateFrequency.Text & " is an invalid value." & vbCrLf & _
                "Must enter a number between 1 and 18000", vbCritical, "Charles Hooper's Oracle Database Time Model Viewer") 

            cboUpdateFrequency.Text = "60"
            lngTimerTriggerSeconds = 60
        End If
    Else
        intResult = MsgBox(cboUpdateFrequency.Text & " is an invalid value." & vbCrLf & _
            "Must enter a number between 1 and 18000", vbCritical, "Charles Hooper's Oracle Database Time Model Viewer")

        cboUpdateFrequency.Text = "60"
        lngTimerTriggerSeconds = 60
    End If
End Sub 

We need similar code in the Exit event of the cboUpdateFrequency ComboBox.  Double-click the cboUpdateFrequency ComboBox, and switch to the Exit event.  Add the following code:

Private Sub cboSessionMinimumPercent_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim intResult As Integer

    If IsNumeric(cboSessionMinimumPercent.Text) Then
        If (Val(cboSessionMinimumPercent.Text) >= 0.001) And (Val(cboSessionMinimumPercent.Text) <= 100) Then
            'OK
        Else
            intResult = MsgBox(cboSessionMinimumPercent.Text & " is an invalid value." & vbCrLf & _
                "Must enter a number between 0.001 and 100.0", vbCritical, "Charles Hooper's Oracle Database Time Model Viewer")

            cboSessionMinimumPercent.Text = "10"
        End If
    Else
        intResult = MsgBox(cboSessionMinimumPercent.Text & " is an invalid value." & vbCrLf & _
            "Must enter a number between 0.001 and 100.0", vbCritical, "Charles Hooper's Oracle Database Time Model Viewer")

        cboSessionMinimumPercent.Text = "10"
    End If
End Sub 

We still need to add the functionality for the chkDisplaySessionDetail CheckBox and the cboSessionMinimumPercent ComboBox, and we have not done anything with the wait events yet (that feature will be added in the next article in this series).  Find the following code section in the UpdateDisplay subroutine:

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

Remove the single quote characters (‘) in front of each of those lines so that the code appears like this:

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

The above simple fix adds the functionality to the chkDisplaySessionDetail CheckBox and the cboSessionMinimumPercent ComboBox.  We still need to provide a list of items in the ComboBoxes that the users are able to select from, and fix the problem where the macro seems to pause unexpectedly when first started.  Switch to the Initialize event in the UserForm (double-click the UserForm’s background area), and then locate the following code in that subroutine:

    'More code will be copied here
    '
    '
    ' 

Just below that section of the code (and above the TimerEvent line), add the following code:

    cboUpdateFrequency.AddItem "5"
    cboUpdateFrequency.AddItem "10"
    cboUpdateFrequency.AddItem "30"
    cboUpdateFrequency.AddItem "60"
    cboUpdateFrequency.AddItem "120"
    cboUpdateFrequency.AddItem "600"
    cboUpdateFrequency.AddItem "3600"
    cboUpdateFrequency.AddItem "7200"
    cboUpdateFrequency.Text = "60"
    lngTimerTriggerSeconds = 60

    cboSessionMinimumPercent.AddItem "1"
    cboSessionMinimumPercent.AddItem "5"
    cboSessionMinimumPercent.AddItem "10"
    cboSessionMinimumPercent.AddItem "15"
    cboSessionMinimumPercent.AddItem "20"
    cboSessionMinimumPercent.AddItem "25"
    cboSessionMinimumPercent.AddItem "50"
    cboSessionMinimumPercent.AddItem "75"
    cboSessionMinimumPercent.Text = "10"

    DoEvents 

In the above, the lines containing .AddItem add entries to the list that is suggested to the user of the tool that we are building.  The lines containing .Text set the default text that appears in each of the ComboBoxes, and the lngTimerTriggerSeconds value must be identical to the numeric value that is assigned to the cboUpdateFrequency.Text property.  Save the project and press the F5 key on the keyboard to display the UserForm and start updating the statistics (after a 60 second delay).  Place a check in the chkDisplaySessionDetail CheckBox (identified as Show Session Detail in the sample project).  You should see something like this (up to 60 seconds after placing a check in that CheckBox):

By looking at the above screen capture it is probably obvious that those sessions which had consumed a small percentage of a Time Model Statistic are displayed with a yellow background, those sessions that had consumed 50% of a Time Model Statistic are displayed with a deep orange background, and sessions that had consumed 100% of a Time Model Statistic are displayed with a solid red background.

We still have a bit more to add to this tool, so keep an eye open for the next article in this series.

—-

Added March 5, 2011:

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





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)





Excel – Charting the Results of Oracle Analytic Functions

6 02 2010

February 6, 2010

This is a somewhat complicated example that builds a couple of sample tables, uses a SQL statement with the Oracle analytic function LEAD submitted through ADO in an Excel macro, and then presents the information on an Excel worksheet.  When the user clicks one of three buttons on the Excel worksheet, an Excel macro executes that then build charts using disconnected row sources – a disconnected ADO recordset is used to sort the data categories before pushing that data into the charts that are built on the fly.

To start, we need to build the sample tables.  The first two tables follow, a part list table and a vendor list table with random data:

CREATE TABLE PART_LIST (
  PART_ID VARCHAR2(30),
  PRODUCT_CODE VARCHAR2(30),
  COMMODITY_CODE VARCHAR2(30),
  PURCHASED CHAR(1),
  PRIMARY KEY (PART_ID));

INSERT INTO
  PART_LIST
SELECT
  DBMS_RANDOM.STRING('Z',10),
  DBMS_RANDOM.STRING('Z',1),
  DBMS_RANDOM.STRING('Z',1),
  DECODE(ROUND(DBMS_RANDOM.VALUE(1,2)),1,'Y','N')
FROM
  DUAL
CONNECT BY
  LEVEL<=50000;

COMMIT;

CREATE TABLE VENDOR_LIST (
  VENDOR_ID VARCHAR2(30),
  PRIMARY KEY (VENDOR_ID));

INSERT INTO
  VENDOR_LIST
SELECT
  DBMS_RANDOM.STRING('Z',10)
FROM
  DUAL
CONNECT BY
  LEVEL<=100; 

COMMIT;

Next, we need to build a purchase transaction history table, allowing a single part to be purchased from 10 randomly selected vendors of the 100 vendors.  This is actually a Cartesian join, but we need to force it to handled as a nested loop join so that we will have a different set of 10 vendors for each PART_ID:

CREATE TABLE PURCHASE_HISTORY (
  TRANSACTION_ID NUMBER,
  VENDOR_ID VARCHAR2(30),
  PART_ID VARCHAR2(30),
  UNIT_PRICE NUMBER(12,2),
  PURCHASE_DATE DATE,
  PRIMARY KEY (TRANSACTION_ID));

INSERT INTO
  PURCHASE_HISTORY
SELECT /*+ ORDERED USE_NL(PL VL) */
  ROWNUM,
  VL.VENDOR_ID,
  PL.PART_ID,
  VL.UNIT_PRICE,
  VL.PURCHASE_DATE
FROM
  PART_LIST PL,
  (SELECT
     'A' MIN_PART,
     'ZZZZZZZZZZZ' MAX_PART,
     VENDOR_ID,
     UNIT_PRICE,
     PURCHASE_DATE,
     ROWNUM RN
  FROM
    (SELECT
      VENDOR_ID,
      ROUND(DBMS_RANDOM.VALUE(0,10000),2) UNIT_PRICE,
      TRUNC(SYSDATE) - ROUND(DBMS_RANDOM.VALUE(0,5000)) PURCHASE_DATE
    FROM
      VENDOR_LIST
    ORDER BY
      DBMS_RANDOM.VALUE)) VL
WHERE
  PL.PURCHASED='Y'
  AND VL.RN<=10
  AND PL.PART_ID BETWEEN VL.MIN_PART AND VL.MAX_PART;

COMMIT;

Before we start working in Excel, we need to put together a SQL statement so that we are able to determine by how much the price of a part fluctuates over time.  We will use the LEAD analytic function to allow us to compare the current row values with the next row values, and only output the row when either the VENDOR_ID changes or the UNIT_PRICE changes.  While the sample data potentially includes dates up to 5,000 days ago, we only want to consider dates up to 720 days ago for this example:

SELECT /*+ ORDERED */
  PH.PART_ID,
  PH.VENDOR_ID,
  PH.UNIT_PRICE,
  PH.LAST_VENDOR_ID,
  PH.LAST_UNIT_PRICE,
  PL.PRODUCT_CODE,
  PL.COMMODITY_CODE
FROM
  (SELECT
    PH.PART_ID,
    PH.VENDOR_ID,
    PH.UNIT_PRICE,
    PH.PURCHASE_DATE,
    LEAD(PH.VENDOR_ID,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_VENDOR_ID,
    LEAD(PH.UNIT_PRICE,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_UNIT_PRICE
  FROM
    PURCHASE_HISTORY PH
  WHERE
    PH.PURCHASE_DATE>=TRUNC(SYSDATE-720)) PH,
  PART_LIST PL
WHERE
  PH.PART_ID=PL.PART_ID
  AND (PH.VENDOR_ID<>NVL(PH.LAST_VENDOR_ID,'-')
    OR PH.UNIT_PRICE<>NVL(PH.LAST_UNIT_PRICE,-1))
ORDER BY
  PH.PART_ID,
  PH.PURCHASE_DATE DESC;

The output of the above SQL statement might look something like this:

PART_ID    VENDOR_ID  UNIT_PRICE LAST_VENDO LAST_UNIT_PRICE P C
---------- ---------- ---------- ---------- --------------- - -
AAAFWXDGOR HHJAWQCYIV    1773.67 RPKWXSTFDS         5841.37 I T
AAAFWXDGOR RPKWXSTFDS    5841.37                            I T
AABDVNQJBS BBOSDBKYBR    4034.07                            D J
AABNDOOTTV HQBZXICKQM    2932.36                            C G
AABPRKFTLG NKYJQJXGJN     242.18 HHJAWQCYIV         1997.01 F I
AABPRKFTLG HHJAWQCYIV    1997.01                            F I
AACHFXHCDC SZWNZCRUWZ    3562.43                            P G
AACNAAOZWE JEYKZFIKJU    4290.12                            L N
AAEAYOLWMN DNDYVXUZVZ    4431.63                            K T
AAFLKRJTCO QPXIDOEDTI    8613.52                            Q G
AAGDNYXQGW BZFMNYJVBP     911.06 RPKWXSTFDS         2813.39 B L
AAGDNYXQGW RPKWXSTFDS    2813.39                            B L
AAGMKTQITK RAGVQSBHKW    9221.90 BCIRRDLHAN         8541.34 S W
AAGMKTQITK BCIRRDLHAN    8541.34 CWQNPITMBE         5611.73 S W
AAGMKTQITK CWQNPITMBE    5611.73                            S W
AAINVDSSWC CQXRSIWOIL    2690.31 BBOSDBKYBR         1707.15 K R
AAINVDSSWC BBOSDBKYBR    1707.15 QFPGRYTYUM         9158.98 K R
AAINVDSSWC QFPGRYTYUM    9158.98                            K R
AALCTODILL NKYJQJXGJN    2116.94                            K M
AAMAUJIWLF LPMSAUJGHR    6294.19 CNHZFDEWIH         4666.58 L P
AAMAUJIWLF CNHZFDEWIH    4666.58 SZWNZCRUWZ         2096.59 L P
AAMAUJIWLF SZWNZCRUWZ    2096.59                            L P
AAMYBVKFQC GLVKOCSHSF     265.63 PNGVEEYGKA         5869.67 X Z
AAMYBVKFQC PNGVEEYGKA    5869.67                            X Z
AANVGRNFEX NFHOKCKLDN    3961.42                            Q O
...

Now we need to switch over to Excel.  Create four ActiveX command buttons named cmdInitialize, cmdComparePC, cmdCompareCC, cmdCompareVendorID.  Name the worksheet OracleAnalyticTest, as shown below:

Right-click the OracleAnalyticTest worksheet and select View Code.  See this blog article to determine how to enable macros in Excel 2007 (if you have not already turned on this feature) and add a reference to the Microsoft ActiveX Data Objects 2.8 (or 6.0) Library.  We will also need to add a reference to the Microsoft ActiveX Data Objects Recordset 2.8 (or 6.0) Library.  Next, we add the code to the cmdInitialize button:

Option Explicit 'Forces all variables to be declared

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 cmdInitialize_Click()
    Dim i As Integer
    Dim intResult As Integer
    Dim lngRow As Long
    Dim strSQL As String
    Dim snpData As ADODB.Recordset

    On Error Resume Next

    Sheets("OracleAnalyticTest").ChartObjects.Delete
    Sheets("OracleAnalyticTest").Rows("4:10000").Delete Shift:=xlUp

    intResult = ConnectDatabase

    If intResult = True Then
        Set snpData = New ADODB.Recordset

        strSQL = "SELECT /*+ ORDERED */" & vbCrLf
        strSQL = strSQL & "  PH.PART_ID," & vbCrLf
        strSQL = strSQL & "  PH.VENDOR_ID," & vbCrLf
        strSQL = strSQL & "  PH.UNIT_PRICE," & vbCrLf
        strSQL = strSQL & "  PH.LAST_VENDOR_ID," & vbCrLf
        strSQL = strSQL & "  PH.LAST_UNIT_PRICE," & vbCrLf
        strSQL = strSQL & "  PL.PRODUCT_CODE," & vbCrLf
        strSQL = strSQL & "  PL.COMMODITY_CODE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  (SELECT" & vbCrLf
        strSQL = strSQL & "    PH.PART_ID," & vbCrLf
        strSQL = strSQL & "    PH.VENDOR_ID," & vbCrLf
        strSQL = strSQL & "    PH.UNIT_PRICE," & vbCrLf
        strSQL = strSQL & "    PH.PURCHASE_DATE," & vbCrLf
        strSQL = strSQL & "    LEAD(PH.VENDOR_ID,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_VENDOR_ID," & vbCrLf
        strSQL = strSQL & "    LEAD(PH.UNIT_PRICE,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_UNIT_PRICE" & vbCrLf
        strSQL = strSQL & "  FROM" & vbCrLf
        strSQL = strSQL & "    PURCHASE_HISTORY PH" & vbCrLf
        strSQL = strSQL & "  WHERE" & vbCrLf
        strSQL = strSQL & "    PH.PURCHASE_DATE>=TRUNC(SYSDATE-270)) PH," & vbCrLf
        strSQL = strSQL & "  PART_LIST PL" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  PH.PART_ID=PL.PART_ID" & vbCrLf
        strSQL = strSQL & "  AND (PH.VENDOR_ID<>NVL(PH.LAST_VENDOR_ID,'-')" & vbCrLf
        strSQL = strSQL & "    OR PH.UNIT_PRICE<>NVL(PH.LAST_UNIT_PRICE,-1))" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  PH.PART_ID," & vbCrLf
        strSQL = strSQL & "  PH.PURCHASE_DATE DESC"
        snpData.Open strSQL, dbDatabase

        If snpData.State = 1 Then
            Application.ScreenUpdating = False

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

            ActiveSheet.Range("A4").CopyFromRecordset snpData

            'Auto-fit up to 26 columns
            ActiveSheet.Columns("A:" & Chr(64 + snpData.Fields.Count)).AutoFit
            ActiveSheet.Range("A4").Select
            ActiveWindow.FreezePanes = True

            'Remove duplicate rows with the same PART ID
            lngRow = 4
            Do While lngRow < Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2
                If Sheets("OracleAnalyticTest").Cells(lngRow, 1).FormulaR1C1 = "" Then
                    'Past the end of the rows
                    Exit Do
                End If
                If Sheets("OracleAnalyticTest").Cells(lngRow - 1, 1).FormulaR1C1 = Sheets("OracleAnalyticTest").Cells(lngRow, 1).FormulaR1C1 Then
                    'Found a duplicate row, delete it
                    Sheets("OracleAnalyticTest").Rows(lngRow).Delete Shift:=xlUp
                Else
                    lngRow = lngRow + 1
                End If
            Loop
            snpData.Close

            Application.ScreenUpdating = True
        End If
    End If

    Set snpData = Nothing
End Sub

The cmdInitialize_Click subroutine retrieves the data from the database using the supplied SQL statement and writes that information to the worksheet.  The macro then eliminates subsequent rows if the part ID is identical to the previous part ID (this step would not have been required if we modified the SQL statement to use the ROW_NUMBER analytic function, and eliminate all rows where the ROW_NUMBER value is not 1).  Once you add the above code, you should be able to switch back to the Excel worksheet, turn off Design Mode, and click the Initialize button.

Unfortunately, this example will retrieve too many rows with too little variation in the PRODUCT_CODE and COMMODITY_CODE columns (just 26 distinct values), so it might be a good idea to delete all rows below row 1004.  Now we need to switch back to the Microsoft Visual Basic editor and add the code for the other three buttons.  Note that this code takes advantage of gradient shading in Excel 2007 charts, so some modification might be necessary on Excel 2003 and earlier.

Private Sub cmdCompareCC_Click()
    Dim i As Long
    Dim intCount As Integer
    Dim intChartNumber As Integer
    Dim lngRows As Long
    Dim dblValues() As Double
    Dim strValueNames() As String
    Dim snpDataList As ADOR.Recordset

    On Error Resume Next

    Sheets("OracleAnalyticTest").ChartObjects.Delete
    Sheets("OracleAnalyticTest").Cells(4, 1).Select
    lngRows = Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2

    'Set up to use ADOR to automatically sort the product codes
    Set snpDataList = New ADOR.Recordset
    snpDataList.Fields.Append "commodity_code", adVarChar, 30
    snpDataList.Open

    'Pick up a distinct list of commodity codes
    For i = 4 To lngRows
        'Only include those commodity codes with price changes
        If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
            If snpDataList.RecordCount > 0 Then
                snpDataList.MoveFirst
            End If
            snpDataList.Find ("commodity_code = '" & Sheets("OracleAnalyticTest").Cells(i, 7) & "'")
            If snpDataList.EOF Then
                'Did not find a matching record
                snpDataList.AddNew
                snpDataList("commodity_code") = Sheets("OracleAnalyticTest").Cells(i, 7).Value
                snpDataList.Update
            End If
        End If
    Next i
    snpDataList.Sort = "commodity_code"

    'Find the matching rows for each product code
    snpDataList.MoveFirst
    Do While Not snpDataList.EOF
        intCount = 0
        ReDim dblValues(250)
        ReDim strValueNames(250)
        For i = 4 To lngRows
            If intCount >= 250 Then
                'Excel charts only permit about 250 data points when created with this method
                Exit For
            End If
            If Sheets("OracleAnalyticTest").Cells(i, 7).Value = snpDataList("commodity_code") Then
                'Found a row with this product code
                If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
                    'Price change was found
                    dblValues(intCount) = Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2)
                    strValueNames(intCount) = Sheets("OracleAnalyticTest").Cells(i, 1).FormulaR1C1
                    intCount = intCount + 1
                End If
            End If
        Next i

        'Set the arrays to the exact number of elements, first element at position 0
        ReDim Preserve dblValues(intCount - 1)
        ReDim Preserve strValueNames(intCount - 1)

        intChartNumber = intChartNumber + 1
        With Sheets("OracleAnalyticTest").ChartObjects.Add(10 * intChartNumber, 60 + 10 * intChartNumber, 400, 300)
            .Chart.SeriesCollection.NewSeries
            .Chart.SeriesCollection(1).Values = dblValues
            .Chart.SeriesCollection(1).XValues = strValueNames
            .Chart.Axes(1).CategoryType = 2
            .Chart.HasLegend = False

            .Chart.HasTitle = True
            .Chart.ChartTitle.Text = "Price Changes by Commodity Code: " & snpDataList("commodity_code")

            .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
            .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Part ID"
            .Chart.Axes(xlValue, xlPrimary).HasTitle = True
            .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Unit Cost Change"

            .Chart.SeriesCollection(1).HasDataLabels = True
            .Chart.SeriesCollection(1).HasLeaderLines = True

            With .Chart.PlotArea.Border
                .ColorIndex = 16
                .Weight = xlThin
                .LineStyle = xlContinuous
            End With

            .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
            .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
            .Chart.PlotArea.Fill.Visible = True
            With .Chart.PlotArea.Border
                .ColorIndex = 57
                .Weight = xlThin
                .LineStyle = xlContinuous
            End With

            .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
            .Chart.SeriesCollection(1).Fill.Visible = True
            .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 4

            .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
            With .Chart.SeriesCollection(1).DataLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8
                .Color = RGB(255, 255, 255)
            End With
            With .Chart.Axes(xlCategory).TickLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8
                .Color = RGB(255, 255, 255)
            End With
            With .Chart.ChartTitle.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 16
                .Color = RGB(0, 0, 255)
            End With
        End With
        snpDataList.MoveNext
    Loop

    Set snpDataList = Nothing
End Sub

Private Sub cmdComparePC_Click()
    Dim i As Long
    Dim intCount As Integer
    Dim intChartNumber As Integer
    Dim lngRows As Long
    Dim dblValues() As Double
    Dim strValueNames() As String
    Dim snpDataList As ADOR.Recordset

    On Error Resume Next

    Sheets("OracleAnalyticTest").ChartObjects.Delete
    Sheets("OracleAnalyticTest").Cells(4, 1).Select
    lngRows = Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2

    'Set up to use ADOR to automatically sort the product codes
    Set snpDataList = New ADOR.Recordset
    snpDataList.Fields.Append "product_code", adVarChar, 30
    snpDataList.Open

    'Pick up a distinct list of product codes
    For i = 4 To lngRows
        'Only include those product codes with price changes
        If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
            If snpDataList.RecordCount > 0 Then
                snpDataList.MoveFirst
            End If
            snpDataList.Find ("product_code = '" & Sheets("OracleAnalyticTest").Cells(i, 6) & "'")
            If snpDataList.EOF Then
                'Did not find a matching record
                snpDataList.AddNew
                snpDataList("product_code") = Sheets("OracleAnalyticTest").Cells(i, 6).Value
                snpDataList.Update
            End If
        End If
    Next i
    snpDataList.Sort = "product_code"

    'Find the matching rows for each product code
    snpDataList.MoveFirst
    Do While Not snpDataList.EOF
        intCount = 0
        ReDim dblValues(250)
        ReDim strValueNames(250)
        For i = 4 To lngRows
            If intCount >= 250 Then
                'Excel charts only permit about 250 data points when created with this method
                Exit For
            End If
            If Sheets("OracleAnalyticTest").Cells(i, 6).Value = snpDataList("product_code") Then
                'Found a row with this product code
                If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
                    'Price change was found
                    dblValues(intCount) = Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2)
                    strValueNames(intCount) = Sheets("OracleAnalyticTest").Cells(i, 1).FormulaR1C1
                    intCount = intCount + 1
                End If
            End If
        Next i

        'Set the arrays to the exact number of elements, first element at position 0
        ReDim Preserve dblValues(intCount - 1)
        ReDim Preserve strValueNames(intCount - 1)

        intChartNumber = intChartNumber + 1

        With Sheets("OracleAnalyticTest").ChartObjects.Add(10 * intChartNumber, 60 + 10 * intChartNumber, 400, 300)
            .Chart.SeriesCollection.NewSeries
            .Chart.SeriesCollection(1).Values = dblValues
            .Chart.SeriesCollection(1).XValues = strValueNames
            .Chart.Axes(1).CategoryType = 2
            .Chart.HasLegend = False

            .Chart.HasTitle = True
            .Chart.ChartTitle.Text = "Price Changes by Product Code: " & snpDataList("product_code")

            .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
            .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Part ID"
            .Chart.Axes(xlValue, xlPrimary).HasTitle = True
            .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Unit Cost Change"

            .Chart.SeriesCollection(1).HasDataLabels = True
            .Chart.SeriesCollection(1).HasLeaderLines = True

            With .Chart.PlotArea.Border
                .ColorIndex = 16
                .Weight = xlThin
                .LineStyle = xlContinuous
            End With

            .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
            .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
            .Chart.PlotArea.Fill.Visible = True
            With .Chart.PlotArea.Border
                .ColorIndex = 57
                .Weight = xlThin
                .LineStyle = xlContinuous
            End With

            .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
            .Chart.SeriesCollection(1).Fill.Visible = True
            .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 5

            .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
            With .Chart.SeriesCollection(1).DataLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8
                .Color = RGB(255, 255, 255)
            End With
            With .Chart.Axes(xlCategory).TickLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8
                .Color = RGB(255, 255, 255)
            End With
            With .Chart.ChartTitle.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 16
                .Color = RGB(0, 0, 255)
            End With
        End With

        snpDataList.MoveNext
    Loop

    Set snpDataList = Nothing
End Sub

Private Sub cmdCompareVendorID_Click()
    Dim i As Long
    Dim intCount As Integer
    Dim intChartNumber As Integer
    Dim lngRows As Long
    Dim dblValues() As Double
    Dim strValueNames() As String
    Dim snpDataList As ADOR.Recordset

    On Error Resume Next

    Sheets("OracleAnalyticTest").ChartObjects.Delete
    Sheets("OracleAnalyticTest").Cells(4, 1).Select
    lngRows = Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2

    'Set up to use ADOR to automatically sort the product codes
    Set snpDataList = New ADOR.Recordset
    snpDataList.Fields.Append "vendor_id", adVarChar, 30
    snpDataList.Open

    'Pick up a distinct list of vendor IDs
    For i = 4 To lngRows
        'Only include those vendor IDs with price changes
        If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
            If snpDataList.RecordCount > 0 Then
                snpDataList.MoveFirst
            End If
            snpDataList.Find ("vendor_id = '" & Sheets("OracleAnalyticTest").Cells(i, 2) & "'")
            If snpDataList.EOF Then
                'Did not find a matching record
                snpDataList.AddNew
                snpDataList("vendor_id") = Sheets("OracleAnalyticTest").Cells(i, 2).Value
                snpDataList.Update
            End If
        End If
    Next i
    snpDataList.Sort = "vendor_id"

    'Find the matching rows for each product code
    snpDataList.MoveFirst
    Do While Not snpDataList.EOF
        intCount = 0
        ReDim dblValues(250)
        ReDim strValueNames(250)
        For i = 4 To lngRows
            If intCount >= 250 Then
                'Excel charts only permit about 250 data points when created with this method
                Exit For
            End If
            If Sheets("OracleAnalyticTest").Cells(i, 2).Value = snpDataList("vendor_id") Then
                'Found a row with this product code
                If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
                    'Price change was found
                    dblValues(intCount) = Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2)
                    strValueNames(intCount) = Sheets("OracleAnalyticTest").Cells(i, 1).FormulaR1C1
                    intCount = intCount + 1
                End If
            End If
        Next i

        'Set the arrays to the exact number of elements, first element at position 0
        ReDim Preserve dblValues(intCount - 1)
        ReDim Preserve strValueNames(intCount - 1)

        intChartNumber = intChartNumber + 1

        With Sheets("OracleAnalyticTest").ChartObjects.Add(10 * intChartNumber, 60 + 10 * intChartNumber, 400, 300)
            .Chart.SeriesCollection.NewSeries
            .Chart.SeriesCollection(1).Values = dblValues
            .Chart.SeriesCollection(1).XValues = strValueNames
            .Chart.Axes(1).CategoryType = 2
            .Chart.HasLegend = False

            .Chart.HasTitle = True
            .Chart.ChartTitle.Text = "Price Changes by Vendor: " & snpDataList("vendor_id")

            .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
            .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Part ID"
            .Chart.Axes(xlValue, xlPrimary).HasTitle = True
            .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Unit Cost Change"

            .Chart.SeriesCollection(1).HasDataLabels = True
            .Chart.SeriesCollection(1).HasLeaderLines = True

            With .Chart.PlotArea.Border
                .ColorIndex = 16
                .Weight = xlThin
                .LineStyle = xlContinuous
            End With

            .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
            .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
            .Chart.PlotArea.Fill.Visible = True
            With .Chart.PlotArea.Border
                .ColorIndex = 57
                .Weight = xlThin
                .LineStyle = xlContinuous
            End With

            .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
            .Chart.SeriesCollection(1).Fill.Visible = True
            .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 45

            .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
            With .Chart.SeriesCollection(1).DataLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8
                .Color = RGB(255, 255, 255)
            End With
            With .Chart.Axes(xlCategory).TickLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 8
                .Color = RGB(255, 255, 255)
            End With
            With .Chart.ChartTitle.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 16
                .Color = RGB(0, 0, 255)
            End With
        End With
        snpDataList.MoveNext
    Loop

    Set snpDataList = Nothing
End Sub

If we switch back to the Excel worksheet, the remaining three buttons should now work.  Clicking each button will cause Excel to examine the data in the worksheet to locate all of the unique values for PRODUCT_CODE, COMMODITY_CODE, or VENDOR_ID, and then sort the list in alphabetical order, and build a chart for each of the part IDs that fall into those categories.  The results for my test run of each button looks like the following three pictures.

You can, of course, adapt the code to work with other SQL statements and modify the chart generating code to alter the chart type, colors, and fonts.





Excel – Scrolling Oracle Performance Charts

20 01 2010

January 20, 2010

This example shows how to generate scrolling charts in Excel that report performance data from V$OSSTAT, V$SYS_TIME_MODEL, and V$SYSSTAT.  This example retrieves 11 statistics from the three views, writes those values to a worksheet, and then calculates the delta values from the previous values read from the database – the last 20 delta values for each statistic are included in the charts.  While this example only generates 4 charts from the data, it is easy to extend the example to build additional charts.

With named cell ranges, it is not necessary to continually change the chart’s data values range, for example, you could create 4 named ranges in Excel and set those ranges as the values ranges for each of the charts:

ChartDBTime:     =IF(COUNTA(ScrollingChartData!$A:$A)>20,OFFSET(ScrollingChartData!$A$5,COUNTA(ScrollingChartData!$A:$A)-21,0,20),OFFSET(ScrollingChartData!$A$5,0,0,COUNTA(ScrollingChartData!$A:$A)-1))
ChartDBCPU:      =IF(COUNTA(ScrollingChartData!$B:$B)>20,OFFSET(ScrollingChartData!$B$5,COUNTA(ScrollingChartData!$B:$B)-21,0,20),OFFSET(ScrollingChartData!$B$5,0,0,COUNTA(ScrollingChartData!$B:$B)-1))
ChartSQLElapsed: =IF(COUNTA(ScrollingChartData!$C:$C)>20,OFFSET(ScrollingChartData!$C$5,COUNTA(ScrollingChartData!$C:$C)-21,0,20),OFFSET(ScrollingChartData!$C$5,0,0,COUNTA(ScrollingChartData!$C:$C)-1))
ChartParseTime:  =IF(COUNTA(ScrollingChartData!$D:$D)>20,OFFSET(ScrollingChartData!$D$5,COUNTA(ScrollingChartData!$D:$D)-21,0,20),OFFSET(ScrollingChartData!$D$5,0,0,COUNTA(ScrollingChartData!$D:$D)-1))

However, I will not use that approach in this example.

First, we need to name the first worksheet as ScrollingChartData and the second worksheet as ScrollingChart, and then create two ActiveX command buttons on the ScrollingChartData worksheet with the names cmdStart and cmdStop:

Next, we need to add a reference to the Microsoft ActiveX Data Objects as demonstrated here.  Also, we need to add a module, and name the module as mdlChartUpdater using the Properties window to assign the name (you can optionally name the two worksheets also).

Now, switch back to the Excel workbook, right-click the ScrollingChartData worksheet and select View Code.  In the Visual Basic editor, add the following code to the code for the worksheet:

Option Explicit

Private Sub cmdStart_Click()
    Dim lngResult As Long
    Dim objChartRange As Range

    On Error Resume Next

    'Clear out any of the old values

    ActiveWorkbook.Sheets("ScrollingChart").ChartObjects.Delete
    ActiveWorkbook.Sheets("ScrollingChartData").Range("4:10000").Clear

    With Sheets("ScrollingChart").ChartObjects.Add(10, 10, 400, 300)
        .Chart.SeriesCollection.NewSeries
        .Chart.Axes(1).CategoryType = 2
        .Chart.SeriesCollection(1).Values = "ScrollingChartData!A5:A5"

        .Chart.HasLegend = False

        .Chart.HasTitle = True
        .Chart.ChartTitle.Text = "DB Time"

        .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
        .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = ""
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = ""

        .Chart.SeriesCollection(1).HasDataLabels = True
        .Chart.SeriesCollection(1).HasLeaderLines = True

        With .Chart.PlotArea.Border
            .ColorIndex = 16
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
        With .Chart.PlotArea.Border
            .ColorIndex = 57
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
        .Chart.SeriesCollection(1).Fill.Visible = True
        .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 4

        .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
        With .Chart.SeriesCollection(1).DataLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.Axes(xlCategory).TickLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.ChartTitle.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            .Color = RGB(0, 0, 255)
        End With
    End With

    With Sheets("ScrollingChart").ChartObjects.Add(410, 10, 400, 300)
        .Chart.SeriesCollection.NewSeries
        .Chart.Axes(1).CategoryType = 2
        .Chart.SeriesCollection(1).Values = "ScrollingChartData!B5:B5"
        .Chart.HasLegend = False

        .Chart.HasTitle = True
        .Chart.ChartTitle.Text = "DB CPU"

        .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
        .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = ""
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = ""

        .Chart.SeriesCollection(1).HasDataLabels = True
        .Chart.SeriesCollection(1).HasLeaderLines = True

        With .Chart.PlotArea.Border
            .ColorIndex = 16
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
        With .Chart.PlotArea.Border
            .ColorIndex = 57
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
        .Chart.SeriesCollection(1).Fill.Visible = True
        .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 3

        .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
        With .Chart.SeriesCollection(1).DataLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.Axes(xlCategory).TickLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.ChartTitle.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            .Color = RGB(0, 0, 255)
        End With
    End With

    With Sheets("ScrollingChart").ChartObjects.Add(10, 320, 400, 300)
        .Chart.SeriesCollection.NewSeries
        .Chart.Axes(1).CategoryType = 2
        .Chart.SeriesCollection(1).Values = "ScrollingChartData!C5:C5"

        .Chart.HasLegend = False

        .Chart.HasTitle = True
        .Chart.ChartTitle.Text = "SQL Elapsed Time"

        .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
        .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = ""
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = ""

        .Chart.SeriesCollection(1).HasDataLabels = True
        .Chart.SeriesCollection(1).HasLeaderLines = True

        With .Chart.PlotArea.Border
            .ColorIndex = 16
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
        With .Chart.PlotArea.Border
            .ColorIndex = 57
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
        .Chart.SeriesCollection(1).Fill.Visible = True
        .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 5

        .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
        With .Chart.SeriesCollection(1).DataLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.Axes(xlCategory).TickLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.ChartTitle.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            .Color = RGB(0, 0, 255)
        End With
    End With

    With Sheets("ScrollingChart").ChartObjects.Add(410, 320, 400, 300)
        .Chart.SeriesCollection.NewSeries
        .Chart.Axes(1).CategoryType = 2
        .Chart.SeriesCollection(1).Values = "ScrollingChartData!D5:D5"
        .Chart.HasLegend = False

        .Chart.HasTitle = True
        .Chart.ChartTitle.Text = "Parse Time"

        .Chart.Axes(xlCategory, xlPrimary).HasTitle = True
        .Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = ""
        .Chart.Axes(xlValue, xlPrimary).HasTitle = True
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = ""

        .Chart.SeriesCollection(1).HasDataLabels = True
        .Chart.SeriesCollection(1).HasLeaderLines = True

        With .Chart.PlotArea.Border
            .ColorIndex = 16
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
        .Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
        .Chart.PlotArea.Fill.Visible = True
        With .Chart.PlotArea.Border
            .ColorIndex = 57
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With

        .Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
        .Chart.SeriesCollection(1).Fill.Visible = True
        .Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 6

        .Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
        With .Chart.SeriesCollection(1).DataLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.Axes(xlCategory).TickLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Color = RGB(255, 255, 255)
        End With
        With .Chart.ChartTitle.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            .Color = RGB(0, 0, 255)
        End With
    End With

    'Make certain that the initial values are specified
    intStopScrollingChart = False
    lngLastRowScrollingChart = 3

    lngResult = mdlChartUpdater.ConnectDatabase

    If lngResult = True Then
        'If the connection attempt was successful, then start the updater
        UpdateChart
    End If
End Sub

Private Sub cmdStop_Click()
    intStopScrollingChart = True
End Sub

When the Start button on the worksheet is clicked, the above code deletes any charts on the ScrollingChart worksheet, creates 4 new charts, and then executes the ConnectDatabase and UpdateChart functions/procedures in the mdlChartUpdater module that was added in an earlier step.

Next, click the mdlChartUpdater module in the Visual Basic editor to switch to that code window – that is where the magic happens.  In the mdlChartUpdater module, add the following code:

Public intStopScrollingChart As Integer 'Used to indicate if the new rows are being added to the ScrollingChart sheet
Public lngLastRowScrollingChart As Long 'Used to keep track of the last row added to the Scrolling Chart tab

Option Explicit 'Forces all variables to be declared

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

Dim intColumns As Integer
Dim strLastColumn As String

Public Function ConnectDatabase() As Integer
    Dim intResult As Integer

    On Error Resume Next

    If dbDatabase.State <> 1 Then
        'Connection to the database if closed
        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

Public Sub UpdateChart()
    Dim sglChange As Single
    Dim strSQL As String

    Dim snpData As ADODB.Recordset

    If intStopScrollingChart = True Then
        Set snpData = Nothing
        Exit Sub
    End If

    On Error Resume Next

    Set snpData = New ADODB.Recordset

    strSQL = "SELECT" & vbCrLf
    strSQL = strSQL & "  STAT_NAME," & vbCrLf
    strSQL = strSQL & "  VALUE" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  V$SYS_TIME_MODEL" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  STAT_NAME IN ('DB time','DB CPU','sql execute elapsed time','parse time elapsed')" & vbCrLf
    strSQL = strSQL & "UNION ALL" & vbCrLf
    strSQL = 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 ('AVG_IDLE_TIME','AVG_BUSY_TIME','AVG_USER_TIME','AVG_SYS_TIME')" & vbCrLf
    strSQL = strSQL & "UNION ALL" & vbCrLf
    strSQL = strSQL & "SELECT" & vbCrLf
    strSQL = strSQL & "  NAME STAT_NAME," & vbCrLf
    strSQL = strSQL & "  VALUE" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  V$SYSSTAT" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  NAME IN ('consistent gets','table scan rows gotten','user calls')"
    snpData.Open strSQL, dbDatabase

    If snpData.State = 1 Then
        lngLastRowScrollingChart = lngLastRowScrollingChart + 1

        'Recordset opened OK
        Do While Not (snpData.EOF)

            'Put the abolute values since startup starting in column 21, with the delta vales starting in column 1
            Select Case snpData("stat_name")
                Case "DB time"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 21).Value = snpData("value") / 1000000
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 1).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 21).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 21).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 1).Value = "DB Time"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 1).Value = 0
                    End If
                Case "DB CPU"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 22).Value = snpData("value") / 1000000
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 2).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 22).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 22).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 2).Value = "DB CPU"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 2).Value = 0
                    End If
                Case "sql execute elapsed time"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 23).Value = snpData("value") / 1000000
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 3).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 23).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 23).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 3).Value = "SQL Exec"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 3).Value = 0
                    End If
                Case "parse time elapsed"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 24).Value = snpData("value") / 1000000
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 4).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 24).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 24).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 4).Value = "Parse Ela"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 4).Value = 0
                    End If
                Case "consistent gets"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 25).Value = snpData("value")
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 5).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 25).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 25).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 5).Value = "Con Gets"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 5).Value = 0
                    End If
                Case "table scan rows gotten"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 26).Value = snpData("value")
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 6).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 26).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 26).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 6).Value = "Tbl Scan Rows"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 6).Value = 0
                    End If
                Case "user calls"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 27).Value = snpData("value")
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 7).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 27).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 27).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 7).Value = "User Calls"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 7).Value = 0
                    End If
                Case "AVG_BUSY_TIME"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 28).Value = snpData("value") / 100
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 8).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 28).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 28).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 8).Value = "Avg Busy"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 8).Value = 0
                    End If
                Case "AVG_IDLE_TIME"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 29).Value = snpData("value") / 100
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 9).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 29).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 29).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 9).Value = "Avg Idle"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 9).Value = 0
                    End If
                Case "AVG_USER_TIME"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 30).Value = snpData("value") / 100
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 10).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 30).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 30).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 10).Value = "Avg User"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 10).Value = 0
                    End If
                Case "AVG_SYS_TIME"
                    Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 31).Value = snpData("value") / 100
                    If lngLastRowScrollingChart > 4 Then
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 11).Value = _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 31).Value - _
                          Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 31).Value
                    Else
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart - 1, 11).Value = "Avg Sys"
                        Sheets("ScrollingChartData").Cells(lngLastRowScrollingChart, 11).Value = 0
                    End If
            End Select

            snpData.MoveNext
        Loop

        snpData.Close
    End If

    If lngLastRowScrollingChart > 4 Then

        'Update the source data locations for each chart - would not need to do this if we used named cell ranges
        ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Values = "ScrollingChartData!A" & _
          Format(IIf(lngLastRowScrollingChart - 19 > 5, lngLastRowScrollingChart - 19, 5)) & ":A" & Format(lngLastRowScrollingChart)
        ActiveSheet.ChartObjects(2).Chart.SeriesCollection(1).Values = "ScrollingChartData!B" & _
          Format(IIf(lngLastRowScrollingChart - 19 > 5, lngLastRowScrollingChart - 19, 5)) & ":B" & Format(lngLastRowScrollingChart)
        ActiveSheet.ChartObjects(3).Chart.SeriesCollection(1).Values = "ScrollingChartData!C" & _
          Format(IIf(lngLastRowScrollingChart - 19 > 5, lngLastRowScrollingChart - 19, 5)) & ":C" & Format(lngLastRowScrollingChart)
        ActiveSheet.ChartObjects(4).Chart.SeriesCollection(1).Values = "ScrollingChartData!D" & _
          Format(IIf(lngLastRowScrollingChart - 19 > 5, lngLastRowScrollingChart - 19, 5)) & ":D" & Format(lngLastRowScrollingChart)
    End If

    If intStopScrollingChart = False Then
        'Instruct Excel to execute the UpdateChart sub again in 60 seconds
        Application.OnTime DateAdd("s", 60, Now), "UpdateChart"
    End If
    Set snpData = Nothing
End Sub

Back in the ScrollingChartData worksheet, click the Start button.  Every 60 seconds (until the Stop button is clicked) the UpdateChart macro will re-execute itself, collecting the most recent statistics from the database.  After the macro has been running for a couple of minutes the worksheet might look something like this:

And the ScrollingChart tab might look something like this (zoomed at 75% – feel free to change the chart colors in the cmdStart code):

After 20+ minutes of logging, the ScrollingChartData worksheet might look like this:

And the ScollingChart worksheet might look like this:

There is certainly a lot that may be done to extend this example, but the above should give you the general idea of what needs to be done.





Excel – Session Viewer with Query Capability

16 01 2010

January 16, 2010

This is a simple example that shows how to query an Oracle database using user input, passing in the user specified values with bind variables.  While this example just queries V$SESSION, it is possible to expand this demonstration considerably to allow Excel to act as a command center for viewing SQL statements executed by sessions (with their execution plans), enable 10046 traces, and more.

To begin, we need to create two ActiveX command buttons in cells A1 through A3.  Name the top command button cmdInitialize, and the bottom button cmdFind.

Next, name the worksheet as DatabaseInfo, then right-click the worksheet DatabaseInfo tab name and select View Code.  Once in the Visual Basic editor, add a reference to the Microsoft ActiveX Data Objects, as demonstrated here.

Now, we need to add the code to make the cmdInitialize button work:

Option Explicit 'Forces all variables to be declared

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

Dim intColumns As Integer
Dim strLastColumn 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
        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 cmdInitialize_Click()
    Dim i As Integer
    Dim intResult As Integer
    Dim strSQL As String
    Dim snpData As ADODB.Recordset

    'Don't allow Excel to display an error message on the screen if an error happens while executing this
    '  procedure, we will handle the problem in-line in the code
    On Error Resume Next

    'Jump to our ConnectDatabase function which returns a value of True if we are connected to the database
    '  or False if the connection attempt failed
    intResult = ConnectDatabase

    'If we could not connect to the database, display a message for the user that something is wrong and stop
    '  the execution of the code in this module
    If intResult = False Then
        Exit Sub
    End If

    'Create the ADO object which will be used to retrieve the data from the database
    Set snpData = New ADODB.Recordset

    strSQL = "SELECT" & vbCrLf
    strSQL = strSQL & "  *" & vbCrLf    'Retrieve all columns from the table without listing the columns
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  V$SESSION" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
  'ROWNUM is an Oracle only function - each row returned is assigned an increasing sequential value,
  '  essentially, I am telling Oracle to not retrieve any rows, as I am just interested in the column name
  '  and the data types in the PART table.  Using 0=1  in place of ROWNUM<1 will likely work on other database
  '  platforms.
    strSQL = strSQL & "  ROWNUM<1"

    'Pass the SQL statement into our database connection to return the matching rows
    snpData.Open strSQL, dbDatabase

    'Always verify that the SQL statement was able to be executed, and that the database server did not simply
    '  return an error message.  Failing to perform the check could result in a situation where the macro
    '  becomes stuck in an infinite loop.  State = 1 indicates that the SQL statement was executed, and that
    '  the recordset is available for use, but does not necessarily mean that there are any rows in the
    '  recordset
    If snpData.State = 1 Then
        For i = 0 To snpData.Fields.Count - 1
            'Let's try to determine the type of data that may be stored in the database column and output that
            '  to the Excel spreadsheet.  Doing so will help the user, and it will help the cmdFind_Click
            '  procedure determine how the bind variables should be set up
            Select Case snpData.Fields(i).Type
                Case adVarChar
                    'A string of characters
                    ActiveSheet.Cells(1, i + 2).Value = "String"
                Case adChar
                    'A fixed length string of characters, where values are padded with spaces as needed
                    ActiveSheet.Cells(1, i + 2).Value = "Character"
                Case adDate, 135
                    'A column which may contain date and time information
                    ActiveSheet.Cells(1, i + 2).Value = "Date"
                Case adNumeric, adSingle, adInteger, adDouble, 139
                    'A column which may contain integers, floating point numbers, but not imaginary numbers
                    ActiveSheet.Cells(1, i + 2).Value = "Number"
                Case Else
                    'What should we do with these types of columns, are they BLOBs, RAWs?
                    ActiveSheet.Cells(1, i + 2).Value = snpData.Fields(i).Type
            End Select
            'Output the name of the column on the second row in the spreadsheet
            ActiveSheet.Cells(2, i + 2).Value = snpData.Fields(i).Name
            'Blank out the third row in the spreadsheet so that the user may specify how the rows returned
            '  by the SQL statement should be restricted on that row
            ActiveSheet.Cells(3, i + 2).Value = ""
        Next i
        'Record the number of columns in the PART table for future reference
        intColumns = snpData.Fields.Count

        'Just for fun, output to the Debug window (View menu - Immediate Window the Excel column names
        '  for the 26th through the 100th columns in the spreadsheet just to make certain that our interesting
        '  looking formula below is working correctly
        For i = 26 To 100
            Debug.Print i, Chr(64 + Int((i + 2) / 26)); Chr(64 + ((i + 2) Mod 26 + 1))
        Next i
        'Chr returns the character represented by the ASCII/ANSI value specified.  An uppercase letter A has
        '  an ASCII/ANSI value of 65, so the first column based on the formula would be Chr(64 + 1) = A
        'Mod is a function which returns the remainder after a number is divided by another number
        '  28 Mod 26 would equal 2  as 28/26 = 1 with a remainder of 2, are to be mathematically fancy:
        '  (28 / 26 - Int(28 / 26)) * 26
        '  Thus Mod produces a repeating sequence from 0 to one less than the number following the word Mod
        strLastColumn = Chr(64 + Int((intColumns + 2) / 26)) & Chr(64 + ((intColumns + 2) Mod 26 + 1))

        'Close the ADO recordset to free up memory on the database server since we are done using the data
        snpData.Close

        'Make certain that the full column names of the various columns in the PART table are visible in the
        '  spreadsheet
        ActiveSheet.Columns("A:" & strLastColumn).AutoFit
    End If

    'Erase any rows in the spreadsheet that may have been left by a previous execution of the cmdFind code
    Worksheets("DatabaseInfo").Range("4:50000").Delete Shift:=xlUp

    'Remove the ADO recordset object that we created earlier from memory - in theory this happens automatically
    '  but it is good practice to explicitly perform the operation
    Set snpData = Nothing
End Sub 

Now, switch back to the Excel window to verify that the cmdInitialize button works correctly.  You should see something like this:

Notice that row 1 in the worksheet shows the data type of the columns in the V$SESSION view (204 is a RAW data type) and row 2 in the worksheet shows the column names.  Row 3 will be used to allow the user to restrict the rows that will be returned.  Next, we need to add the code to the cmdFind button.  Switch back to the Visual Basic editor and add the following code:

Private Sub cmdFind_Click()
    Dim i As Integer
    Dim lngRow As Long
    Dim strSQL As String
    Dim snpData As ADODB.Recordset
    Dim comData As ADODB.Command

    'Create the in-memory ADO objects that will be used to return the data from the PART table
    Set snpData = New ADODB.Recordset
    Set comData = New ADODB.Command

    With comData
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  *" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  V$SESSION" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  1=1" & vbCrLf

        'Walk through the columns to determine which have restrictions placed on them by the user
        For i = 1 To intColumns
            If ActiveSheet.Cells(3, i).Value <> "" Then
                'The user placed a striction on this column
                If (InStr(ActiveSheet.Cells(3, i).Value, "%") > 0) Or (InStr(ActiveSheet.Cells(3, i).Value, "_") > 0) Then
                    'Partial match, the column name is in row 2 of the spreadsheet
                    strSQL = strSQL & "  AND " & ActiveSheet.Cells(2, i).Value & " LIKE ?" & vbCrLf
                    'We need to look in row 1 for the data type of the column and set up an appropriate bind
                    '  variable data type to pass in the restriction requested by the user
                    'Each bind variable must have a unique name, so we generate one as  ValueCol#
                    Select Case ActiveSheet.Cells(1, i).Value
                        Case "String"
                            .Parameters.Append .CreateParameter("value" & Format(i), adVarChar, adParamInput, Len(ActiveSheet.Cells(3, i).Value), ActiveSheet.Cells(3, i).Value)
                        Case "Character"
                            .Parameters.Append .CreateParameter("value" & Format(i), adChar, adParamInput, Len(ActiveSheet.Cells(3, i).Value), ActiveSheet.Cells(3, i).Value)
                        Case "Number"
                            'A partial match on a number is not possible, just including to see what happens
                            .Parameters.Append .CreateParameter("value" & Format(i), adNumeric, adParamInput, 12, ActiveSheet.Cells(3, i).Value)
                        Case "Date"
                            'A partial match on a date is not possible, just including to see what happens
                            .Parameters.Append .CreateParameter("value" & Format(i), adDate, adParamInput, 8, CDate(ActiveSheet.Cells(3, i).Value))
                    End Select
                Else
                    'Full match, the column name is in row 2 of the spreadsheet
                    strSQL = strSQL & "  AND " & ActiveSheet.Cells(2, i).Value & " = ?" & vbCrLf
                    'We need to look in row 1 for the data type of the column and set up an appropriate bind
                    '  variable data type to pass in the restriction requested by the user
                    'Each bind variable must have a unique name, so we generate one as  ValueCol#
                    Select Case ActiveSheet.Cells(1, i).Value
                        Case "String"
                            .Parameters.Append .CreateParameter("value" & Format(i), adVarChar, adParamInput, Len(ActiveSheet.Cells(3, i).Value), ActiveSheet.Cells(3, i).Value)
                        Case "Character"
                            .Parameters.Append .CreateParameter("value" & Format(i), adChar, adParamInput, Len(ActiveSheet.Cells(3, i).Value), ActiveSheet.Cells(3, i).Value)
                        Case "Number"
                            .Parameters.Append .CreateParameter("value" & Format(i), adNumeric, adParamInput, 12, ActiveSheet.Cells(3, i).Value)
                        Case "Date"
                            .Parameters.Append .CreateParameter("value" & Format(i), adDate, adParamInput, 8, CDate(ActiveSheet.Cells(3, i).Value))
                    End Select
                End If
            End If
        Next i
        'We will sort the rows by the part ID
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  SID"

        'Set up the command properties
        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30

        .ActiveConnection = dbDatabase
    End With

    Set snpData = comData.Execute

    lngRow = 3 'We will start outputting at row 4, so 3 is our "0" line - the starting point

    'The slow way to populate the cells
'    If Not (snpData Is Nothing) Then
'        Do While Not snpData.EOF
'            'Increase the row number so that we do not output all of the information on the same row of the
'            '  spreadsheet
'            lngRow = lngRow + 1
'            'Output the data returned by the SQL statement, one column at a time.  The first column is in the
'            '  0 position, and the last column is one less than the total number of columns returned
'            For i = 0 To snpData.Fields.Count - 1
'                ActiveSheet.Cells(lngRow, i + 2).Value = snpData.Fields(i)
'            Next i
'            snpData.MoveNext
'        Loop
'
'        snpData.Close
'    End If
'
'    'Do we have extra rows left over from the last run?  If so, delete all rows below the last row that we output
'    Worksheets("DatabaseInfo").Range(Format(lngRow + 1) & ":50000").Delete Shift:=xlUp

    'The fast way to place the query results into cells   
    Worksheets("DatabaseInfo").Range(Format(lngRow + 1) & ":50000").Delete Shift:=xlUp
    If Not (snpData Is Nothing) Then

        ActiveSheet.Range("B4").CopyFromRecordset snpData

        ActiveSheet.Range("B4").Select

        snpData.Close
    End If

    'Tell Excel to fix the column widths so that all of the data returned in each column is visible
    'We recorded the value of strLastColumn in the initialize procedure
    ActiveSheet.Columns("B:" & strLastColumn).AutoFit

    'Memory clean up
    Set snpData = Nothing
    Set comData = Nothing
End Sub

Switch back to the Excel worksheet and test the cmdFind button.  You should see something like this:

Next, try to enter a search keyword in row 3 – if a wildcard character ( % or _ ) is used, the query will use a LIKE keyword, rather than an = operator.  After entering the search criteria, click the Find button:

There is no need to stop at this point.  It is easy to add a UserForm to the Excel workbook, for example something like this from another demonstration: 

For example, to enable a trace for a session, you could create a function like this:

Sub SetTraceInSession(lngSID As Long, lngSerial As Long, lngTrace As Long, lngTraceLevel As Long)
    Dim cmdTrace As New ADODB.Command
    Dim strSQL As String

    On Error Resume Next

    With cmdTrace
        strSQL = "SYS.DBMS_SYSTEM.SET_EV(" & Format(lngSID) & "," & Format(lngSerial) & "," & Format(lngTrace) & "," & Format(lngTraceLevel) & ",'')"
        .CommandText = strSQL
        .CommandType = adCmdStoredProc
        .ActiveConnection = dbDatabase
    End With

    cmdTrace.Execute

    Set cmdTrace = Nothing
End Sub




Select From or Update a Database Table Based on the Contents of an Excel Spreadsheet

12 01 2010

January 12, 2010

Let’s say that there is an Excel spreadsheet containing a list of customer order IDs in column A, and you would like to query an Oracle database using the value in column A, and then display a message on the screen showing the results of the query.  The following macro code will do just that:

Sub CheckSpreadsheet() 
    Dim dbMyDB As New ADODB.Connection 
    Dim snpData As New ADODB.Recordset 
    Dim intLastRowChecked 
    Dim intFoundFirstBlank 
    Dim intResult As Integer 
    Dim intColumn 
    Dim strColumn 
    Dim strFilename 
    Dim strWorkbookname 
    Dim strSheet 
    Dim strExcelValue 
    Dim strSQL 
    Dim strMessage
    'You must create a reference to Microsoft ActiveX Data Objects (Tools menu)
    'Make sure that we don't crash - will look ugly if our macro crashes
    On Error Resume Next
    'Replace MyODBCConnection with an ODBC connection name, MyUserName with a database user name and MyPassword with the user's password 
    dbMyDB.ConnectionString = "Data Source=MyODBCConnection;User ID=MyUserName;Password=MyPassword;"
    dbMyDB.ConnectionTimeout = 40 
    dbMyDB.CursorLocation = adUseClient 
    dbMyDB.Open
    strWorkbookname = Right(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) -InStrRev(ActiveWorkbook.FullName, "\")) 
    strSheet = ActiveSheet.Name
    intLastRowChecked = 1 'Set to skip the first row 
    intColumn = 65  'Column A 
    strColumn = Chr(intColumn)
    Do While intFoundFirstBlank = False 
        intLastRowChecked = intLastRowChecked + 1
        'Read the value from the spreadsheet 
        strExcelValue = Format(Workbooks(strWorkbookname).Worksheets(strSheet).Range(strColumn & Format(intLastRowChecked)).Value)
        If strExcelValue = "" Then 
            intFoundFirstBlank = True 
        Else 
            'Could perform an INSERT statement rather than a SELECT statement 
            strSQL = "SELECT" & vbCrLf 
            strSQL = strSQL & "  LINE_NO," & vbCrLf 
            strSQL = strSQL & "  PART_ID," & vbCrLf 
            strSQL = strSQL & "  ORDER_QTY," & vbCrLf 
            strSQL = strSQL & "  DESIRED_SHIP_DATE" & vbCrLf 
            strSQL = strSQL & "FROM" & vbCrLf 
            strSQL = strSQL & "  CUST_ORDER_LINE" & vbCrLf 
            strSQL = strSQL & "WHERE" & vbCrLf 
            strSQL = strSQL & "  CUST_ORDER_ID='" & strExcelValue & "'" & vbCrLf 
            strSQL = strSQL & "ORDER BY" & vbCrLf 
            strSQL = strSQL & "  DESIRED_SHIP_DATE"
            snpData.Open strSQL, dbMyDB
            Do While Not snpData.EOF 
                strMessage = strExcelValue & "/" & Format(snpData("line_no")) & " " & Format(snpData("desired_ship_date"), "m/d/yyyy") & _
                             " " & snpData("part_id") & " Qty " & Format(snpData("order_qty")) 
                MsgBox strMessage
                snpData.MoveNext 
            Loop 
            snpData.Close 
        End If 
    Loop
    Set snpData = Nothing 
    dbMyDB.Close 
    Set dbMyDB = Nothing 
End Sub

Note that there are a couple minor issues with the above script:

  • The script runs until it finds a blank cell in column A, rather than using an Excel feature to identify the bounds of the range.
  • The script requires an ODBC (32 bit) to be created on the computer.  Search the other articles on this blog to see how to establish a connection to the database without creating an ODBC connection.
  • The script does not use bind variables.  Search the other articles on this blog to see how to implement bind variables in an Excel macro.

By changing the script slightly, the SELECT statement could be modified to be an UPDATE statement, allowing an easy method to update the database based on data contained in the Excel spreadsheet.





Excel – Graphical Scheduled Usage Viewer for Production Equipment

1 01 2010

January 1, 2010

This article is based on a sample included in a presentation that I conducted a couple of months ago.  Essentially, this example pulls utilization schedules from multiple equipment resources and generates both an equipment resource specific calendar and a graphical overview of the calendars for all equipment resources.  This demonstration uses ADO with a direct connection to an Oracle database for both scheduling the work orders that need to be processed at each of the equipment resources (using a very weak scheduling algorithm that does not go back to fill in unused time), and to create the graphical results in Excel.

The options area for the original Excel spreadsheet used in my presentation looked like this, but we will not create anything that complex in this article: 

Before starting, we need to create source data for our example (note that some of the tables created are only needed for a short period of time, and may be dropped once all of the tables are created):

First, a statistic list of parts that will be manufactured:

CREATE TABLE
  T_PART_LIST AS
SELECT
  CAST(DBMS_RANDOM.STRING('U',15) AS VARCHAR2(30)) PART_ID,
  ROUND(DBMS_RANDOM.VALUE(1,30)) NUM_LOTS,
  ROUND(DBMS_RANDOM.VALUE(1,10)) NUM_OPERATIONS
FROM
  DUAL
CONNECT BY
  LEVEL<=100;

Next, the operation numbers and machine resources that will be used during the manufacture of each of the parts:

CREATE TABLE
  T_PART_OPERATION AS
SELECT
  PL.PART_ID,
  OP.RN*10 OPERATION_SEQ_NO,
  CAST(ROUND(DBMS_RANDOM.VALUE(0,10),2) AS NUMBER(22,2)) RUN_HOURS,
  CAST('MACHINE'||TO_CHAR(ROUND(DBMS_RANDOM.VALUE(1,100)),'000') AS VARCHAR2(15)) RESOURCE_ID
FROM
  T_PART_LIST PL,
  (SELECT
    ROWNUM RN
  FROM
    DUAL
  CONNECT BY
    LEVEL<=10) OP
WHERE
  OP.RN<=PL.NUM_OPERATIONS;

CREATE INDEX IND_T_PART_OP_PART_ID ON T_PART_OPERATION(PART_ID);

Next, the work order lots that will manufacture the parts:

CREATE TABLE
  T_WORKORDER_LIST AS
SELECT
  WO.WORKORDER_BASE_ID,
  CAST(LN.LOT_NUM AS VARCHAR2(3)) WORKORDER_LOT_ID,
  PL.PART_ID,
  TRUNC(SYSDATE+ROUND(DBMS_RANDOM.VALUE(0,400))) DESIRED_WANT_DATE
FROM
  (SELECT
    PART_ID,
    NUM_LOTS,
    ROWNUM RN
  FROM
    T_PART_LIST) PL,
  (SELECT
    CAST('W'||TO_CHAR(ROWNUM+10000) AS VARCHAR2(15)) WORKORDER_BASE_ID,
    ROWNUM RN
  FROM
    DUAL
  CONNECT BY
    LEVEL<=400) WO,
  (SELECT
    ROWNUM LOT_NUM
  FROM
    DUAL
  CONNECT BY
    LEVEL<=30) LN
WHERE
  PL.RN=WO.RN
  AND LN.LOT_NUM<=PL.NUM_LOTS
ORDER BY
  WO.WORKORDER_BASE_ID,
  LN.LOT_NUM;

Finally, a table that will eventually contain the schedules for the various machine resources:

CREATE TABLE T_RESOURCE_DAILY_SCH(
  RESOURCE_ID VARCHAR2(15),
  START_DATE DATE,
  FINISH_DATE DATE,
  RUN_HOURS NUMBER,
  PART_ID VARCHAR2(30),
  WORKORDER_BASE_ID VARCHAR2(15),
  WORKORDER_LOT_ID VARCHAR2(3),
  OPERATION_SEQ_NO NUMBER,
  DESIRED_WANT_DATE DATE,
  UNIT_ASSIGNED NUMBER);

CREATE INDEX IND_T_RESOURCE_DAILY_RES ON T_RESOURCE_DAILY_SCH(RESOURCE_ID);

We now switch to Excel to build the interface area with two ActiveX command buttons:

First, name the first worksheet as ShopCalendar  – this name is very important since it is referenced in the code for this example.  Next, add two ActiveX command buttons in the first two rows.  Give the first one the name cmdCreateSchedule, and the second one the name cmdDrawCalendar  – the names are not overly critical, but the names are referenced in the code.  Finally, double-click one of the buttons to access the Code Editor.

Delete any code that is shown in the Code Editor and add the following code:

Option Explicit

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

The above code is the basic logic needed to permit connecting to the Oracle database.  Next, add a reference to the ActiveX Data Objects.  Now we need to add the code for the scheduling routine – this code uses bind variables to minimize the number of hard parses:

Private Sub cmdCreateSchedule_Click()
    Dim intResult As Integer
    Dim strSQL As String
    Dim i As Integer
    Dim intResourceIndex As Integer      'Index that indicates the current resource ID index
    Dim strResourceID(100) As String     'Keep track of the new resource IDs read in
    Dim varResourceLastDate(100) As Date 'Keep track of the last date for the resource
    Dim strWorkOrderLast As String       'Used to make certain that the next operation starts after the previous
    Dim varWorkOrderLastDate As Date     'Used to make certain that the next operation starts after the previous
    Dim varScheduleStart As Date         'The first date in the schedule
    Dim snpData As ADODB.Recordset
    Dim comData As ADODB.Command

    intResult = ConnectDatabase
    If intResult = False Then
        Exit Sub
    End If

    'Set the starting point for all resources
    varScheduleStart = Now
    For i = 1 To 100
        strResourceID(i) = ""
        varResourceLastDate(i) = varScheduleStart
    Next i

    Set snpData = New ADODB.Recordset
    Set comData = New ADODB.Command

    'Retrieve the list of work order operations to be scheduled
    strSQL = "SELECT" & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  WO.PART_ID," & vbCrLf
    strSQL = strSQL & "  WO.DESIRED_WANT_DATE," & vbCrLf
    strSQL = strSQL & "  PO.OPERATION_SEQ_NO," & vbCrLf
    strSQL = strSQL & "  PO.RUN_HOURS," & vbCrLf
    strSQL = strSQL & "  PO.RESOURCE_ID" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  T_WORKORDER_LIST WO," & vbCrLf
    strSQL = strSQL & "  T_PART_OPERATION PO" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  WO.PART_ID=PO.PART_ID" & vbCrLf
    strSQL = strSQL & "ORDER BY" & vbCrLf
    strSQL = strSQL & "  WO.DESIRED_WANT_DATE," & vbCrLf
    strSQL = strSQL & "  WO.PART_ID," & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  PO.OPERATION_SEQ_NO"
    snpData.Open strSQL, dbDatabase

    If snpData.State = 1 Then
        'Remove the previous run
        dbDatabase.Execute "TRUNCATE TABLE T_RESOURCE_DAILY_SCH"

        'Set up the ADO command object to use bind variables
        With comData
            strSQL = "INSERT INTO T_RESOURCE_DAILY_SCH (" & vbCrLf
            strSQL = strSQL & "  RESOURCE_ID," & vbCrLf
            strSQL = strSQL & "  START_DATE," & vbCrLf
            strSQL = strSQL & "  FINISH_DATE," & vbCrLf
            strSQL = strSQL & "  RUN_HOURS," & vbCrLf
            strSQL = strSQL & "  PART_ID," & vbCrLf
            strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
            strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
            strSQL = strSQL & "  OPERATION_SEQ_NO," & vbCrLf
            strSQL = strSQL & "  DESIRED_WANT_DATE," & vbCrLf
            strSQL = strSQL & "  UNIT_ASSIGNED)" & vbCrLf
            strSQL = strSQL & "VALUES (" & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?)"

            .Parameters.Append .CreateParameter("resource_id", adVarChar, adParamInput, 15, "")
            .Parameters.Append .CreateParameter("start_date", adDate, adParamInput, 8, Null)
            .Parameters.Append .CreateParameter("finish_date", adDate, adParamInput, 8, Null)
            .Parameters.Append .CreateParameter("run_hours", adNumeric, adParamInput, 12, 0)
            .Parameters.Append .CreateParameter("part_id", adVarChar, adParamInput, 30, "")
            .Parameters.Append .CreateParameter("workorder_base_id", adVarChar, adParamInput, 15, "")
            .Parameters.Append .CreateParameter("workorder_lot_id", adVarChar, adParamInput, 3, "")
            .Parameters.Append .CreateParameter("operation_seq_no", adNumeric, adParamInput, 12, 10)
            .Parameters.Append .CreateParameter("desired_want_date", adDate, adParamInput, 8, Null)
            .Parameters.Append .CreateParameter("unit_assigned", adNumeric, adParamInput, 12, 10)

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

        dbDatabase.BeginTrans

        Do While Not snpData.EOF
            'Find the last operation date for this resource
            intResourceIndex = 0
            For i = 1 To 100
                If strResourceID(i) = snpData("resource_id") Then
                    intResourceIndex = i
                    Exit For
                End If
                If strResourceID(i) = "" Then
                    'No match found, create a new one
                    intResourceIndex = i
                    strResourceID(i) = snpData("resource_id")
                    Exit For
                End If
            Next i

            If strWorkOrderLast <> snpData("workorder_base_id") & "//" & snpData("workorder_lot_id") Then
                varWorkOrderLastDate = varScheduleStart
            End If

            If varResourceLastDate(intResourceIndex) >= varWorkOrderLastDate Then
                comData("start_date") = varResourceLastDate(intResourceIndex)
            Else
                comData("start_date") = varWorkOrderLastDate
            End If

            If varResourceLastDate(intResourceIndex) >= varWorkOrderLastDate Then
                comData("finish_date") = DateAdd("n", snpData("run_hours") * 60, varResourceLastDate(intResourceIndex))
                varWorkOrderLastDate = DateAdd("n", snpData("run_hours") * 60, varResourceLastDate(intResourceIndex))
            Else
                comData("finish_date") = DateAdd("n", snpData("run_hours") * 60, varWorkOrderLastDate)
                varWorkOrderLastDate = DateAdd("n", snpData("run_hours") * 60, varWorkOrderLastDate)
            End If

            varResourceLastDate(intResourceIndex) = varWorkOrderLastDate
            strWorkOrderLast = snpData("workorder_base_id") & "//" & snpData("workorder_lot_id")

            comData("resource_id") = snpData("resource_id")
            comData("run_hours") = snpData("run_hours")
            comData("part_id") = snpData("part_id")
            comData("workorder_base_id") = snpData("workorder_base_id")
            comData("workorder_lot_id") = snpData("workorder_lot_id")
            comData("operation_seq_no") = snpData("operation_seq_no")
            comData("desired_want_date") = snpData("desired_want_date")
            comData("unit_assigned") = 1

            'Execute the insert statement with bind variables
            comData.Execute

            snpData.MoveNext
        Loop
        snpData.Close

        'Issue a COMMIT
        dbDatabase.CommitTrans
    Else
        intResult = MsgBox("Could not query the database." & vbCrLf & Error(Err), 16, "Excel Demo")
    End If

    Set snpData = Nothing
    Set comData = Nothing
End Sub

Switch back to the Excel window and turn off Design Mode.  Clicking the Create Schedule button should populate the T_RESOURCE_DAILY_SCH table.  Once that code finishes executing, switch back to the Code Editor and add the following below the rest of the code:

Private Sub cmdDrawCalendar_Click()
    Dim i As Long
    Dim j As Integer
    Dim intFlag As Integer
    Dim intBaseRow As Integer
    Dim intBaseRowMax As Integer
    Dim intDataRow As Integer
    Dim intWeek As Integer
    Dim intResult As Integer
    Dim intWeekDay As Integer
    Dim intGraphicalMovable As Integer      'Determines if a graphical view will be created
    Dim intGraphicalFixed As Integer        'Determines if a graphical metafile will be created
    Dim strSQL As String
    Dim strLastResourceID As String
    Dim strLine As String
    Dim varWeekStart(1000) As Date
    Dim varWeekEnd(1000) As Date

    Dim lngBoxHeight As Long
    Dim lngBoxLengthMult As Single
    Dim lngFontSize As Long
    Dim lngBoxTop As Long
    Dim lngBoxLeft As Long
    Dim lngBoxWidth As Long
    Dim lngMaxCapacity As Long
    Dim varBaseDate As Date

    Dim lngResourceTop As Long     'Current top position for the resource ID

    Dim strFilename As String
    Dim snpData As ADODB.Recordset
    Dim comData As ADODB.Command

    'Don't break the code if an error is returned
    On Error Resume Next

    intGraphicalMovable = True
    intGraphicalFixed = False

    intResult = ConnectDatabase

    If intResult = False Then
        intResult = MsgBox("Could not connect to the Visual database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo")

        Exit Sub
    End If

    If intGraphicalFixed = True Then
        'See if we need to delete the worksheet from a previous execution
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Name = "ShopCalendarViewFixed" Then
                Sheets("ShopCalendarViewFixed").Select
                Application.DisplayAlerts = False
                ActiveWindow.SelectedSheets.Delete
                Application.DisplayAlerts = True
                Exit For
            End If
        Next i

        'Add a new worksheet to the workbook after the ShopCalendar worksheet
        ActiveWorkbook.Sheets.Add , Sheets("ShopCalendar")
        ActiveWorkbook.ActiveSheet.Name = "ShopCalendarViewFixed"
    End If

    If intGraphicalMovable = True Then
        'See if we need to delete the worksheet from a previous execution
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Name = "ShopCalendarView" Then
                Sheets("ShopCalendarView").Select
                Application.DisplayAlerts = False
                ActiveWindow.SelectedSheets.Delete
                Application.DisplayAlerts = True
                Exit For
            End If
        Next i

        'Add a new worksheet to the workbook after the ShopCalendar worksheet
        ActiveWorkbook.Sheets.Add , Sheets("ShopCalendar")
        ActiveWorkbook.ActiveSheet.Name = "ShopCalendarView"
    End If

    Sheets("ShopCalendar").Select

    Set snpData = New ADODB.Recordset
    Set comData = New ADODB.Command

    Sheets("ShopCalendar").Rows("13:10000").Delete Shift:=xlUp

    With comData
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  RESOURCE_ID," & vbCrLf
        strSQL = strSQL & "  START_DATE," & vbCrLf
        strSQL = strSQL & "  FINISH_DATE," & vbCrLf
        strSQL = strSQL & "  RUN_HOURS," & vbCrLf
        strSQL = strSQL & "  PART_ID," & vbCrLf
        strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
        strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
        strSQL = strSQL & "  OPERATION_SEQ_NO," & vbCrLf
        strSQL = strSQL & "  DESIRED_WANT_DATE," & vbCrLf
        strSQL = strSQL & "  UNIT_ASSIGNED" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  T_RESOURCE_DAILY_SCH" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  START_DATE<=TRUNC(SYSDATE+45)" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  RESOURCE_ID," & vbCrLf
        strSQL = strSQL & "  START_DATE," & vbCrLf
        strSQL = strSQL & "  FINISH_DATE," & vbCrLf
        strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
        strSQL = strSQL & "  WORKORDER_LOT_ID"

        'Set up the command properties
        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30
        .ActiveConnection = dbDatabase
    End With

    Set snpData = comData.Execute

    varBaseDate = Date
    lngBoxLengthMult = 0.1
    lngBoxHeight = 8
    lngResourceTop = 30
    lngFontSize = 6

    varBaseDate = Date

    If Not (snpData Is Nothing) Then
    'If snpData.State = 1 Then
        Application.ScreenUpdating = False

        If intGraphicalMovable = True Then
            For i = 0 To 30
                lngBoxLeft = 70 + lngBoxLengthMult * (i * 60 * 24)
                lngBoxWidth = lngBoxLengthMult * (60 * 24) - 1
                With Sheets("ShopCalendarView").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight * 2 - 1))
                    With .TextFrame
                        .Characters.Text = Format(DateAdd("d", i, varBaseDate), "m/d")
                        .Characters.Font.Size = (lngBoxHeight - 2) * 2
                    End With
                    .Fill.ForeColor.RGB = RGB(255 - 4 * (Weekday(DateAdd("d", i, varBaseDate), vbMonday) - 1), 255 - 4 * (Weekday(DateAdd("d", i, varBaseDate), vbMonday) - 1), 255 - 4 * (Weekday(DateAdd("d", i, varBaseDate), vbMonday) - 1))
                End With
            Next i
        End If

        If Not (snpData.EOF) Then
            intBaseRowMax = 10

            'Find the week start and end dates of each week
            varWeekStart(1) = CDate(Format(DateAdd("d", -Weekday(snpData("start_date"), vbMonday) + 1, snpData("start_date")), "mm/dd/yyyy"))
            varWeekEnd(1) = DateAdd("d", 6, varWeekStart(1))
            For i = 2 To 1000
                varWeekStart(i) = DateAdd("d", (i - 1) * 7, varWeekStart(1))
                varWeekEnd(i) = DateAdd("d", 6, varWeekStart(i))
            Next i

            Do While Not snpData.EOF
                If strLastResourceID <> snpData("resource_id") Then
                    'Started a new resource ID
                    If intBaseRow > 10 Then
                        'Write out the week start dates for the last resource, and draw the borders
                        For i = intBaseRow To intBaseRowMax - 1
                            Sheets("ShopCalendar").Cells(i + 1, 1).Value = Format(varWeekStart(i - intBaseRow + 1), "mm/dd/yyyy")
                        Next i

                        Sheets("ShopCalendar").Range("B" & Format(intBaseRow) & ":H" & Format(intBaseRowMax)).Select
                        With Selection.Borders(xlEdgeLeft)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlEdgeTop)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlEdgeBottom)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlEdgeRight)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlInsideVertical)
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlInsideHorizontal)
                            .Weight = xlThin
                        End With
                    End If

                    If intGraphicalMovable = True Then
                        'For the graphical view
                        lngResourceTop = lngResourceTop + lngMaxCapacity * (lngBoxHeight) + 10
                        lngBoxLeft = 1
                        lngBoxWidth = 40
                        lngBoxTop = lngResourceTop

                        With Sheets("ShopCalendarView").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight - 1))
                            With .TextFrame
                                '.AutoMargins = False
                                .Characters.Text = snpData("resource_id")
                                .Characters.Font.Size = lngBoxHeight - 2
                                .MarginLeft = 0
                                .MarginRight = 0
                                .MarginTop = 0
                                .MarginBottom = 0
                            End With
                            .Fill.ForeColor.RGB = RGB(255, 255, 255)
                        End With
                    End If

                    lngMaxCapacity = 0

                    intBaseRow = intBaseRowMax + 4
                    strLastResourceID = snpData("resource_id")

                    Sheets("ShopCalendar").Cells(intBaseRow - 1, 1).Value = snpData("resource_id")
                    Sheets("ShopCalendar").Cells(intBaseRow - 1, 1).Font.Bold = True
                    Sheets("ShopCalendar").Cells(intBaseRow - 1, 1).Font.Size = 14
                    For i = 1 To 7
                        Sheets("ShopCalendar").Cells(intBaseRow, i + 1).Value = Format(DateAdd("d", i - 1, varWeekStart(1)), "DDD")
                        Sheets("ShopCalendar").Cells(intBaseRow, i + 1).Font.Bold = True
                    Next i
                End If

                If Not IsNull(snpData("unit_assigned")) Then
                   If lngMaxCapacity < snpData("unit_assigned") Then
                        'Need to update the maximum unit assigned value
                        lngMaxCapacity = snpData("unit_assigned")
                    End If

                    If (varBaseDate < snpData("start_date")) Or (varBaseDate < snpData("finish_date")) Then
                        If lngMaxCapacity < snpData("unit_assigned") Then
                            lngMaxCapacity = snpData("unit_assigned")
                        End If

                        If intGraphicalMovable = True Then
                            lngBoxLeft = 70 + lngBoxLengthMult * (DateDiff("n", varBaseDate, snpData("start_date")))
                            lngBoxWidth = lngBoxLengthMult * ((DateDiff("n", varBaseDate, snpData("finish_date")) - DateDiff("n", varBaseDate, snpData("start_date"))))
                            lngBoxTop = lngResourceTop + snpData("unit_assigned") * lngBoxHeight

                            With Sheets("ShopCalendarView").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight - 1))
                                With .TextFrame
                                    '.AutoMargins = False
                                    .Characters.Text = snpData("workorder_base_id") & "/" & snpData("workorder_lot_id") & " OP " & CStr(snpData("operation_seq_no"))
                                    .Characters.Font.Size = lngBoxHeight - 2
                                    .MarginLeft = 0
                                    .MarginRight = 0
                                    .MarginTop = 0
                                    .MarginBottom = 0
                                End With
                                If snpData("finish_date") > snpData("desired_want_date") Then
                                    .Fill.ForeColor.RGB = RGB(255, 0, 0)
                                Else
                                    .Fill.ForeColor.RGB = RGB(0, 255, 255)
                                End If
'                                If snpData("workorder_sub_id") = "0" Then
                                    .AlternativeText = "WO:" & snpData("workorder_base_id") & "/" & snpData("workorder_lot_id") & " OP:" & CStr(snpData("operation_seq_no")) & Chr(10) & "Part ID:" & snpData("part_id") & Chr(10) & Format(snpData("start_date"), "mm/dd/yyyy hh:nn") & " - " & Format(snpData("finish_date"), "mm/dd/yyyy hh:nn") & Chr(10) & snpData("resource_id")
'                                Else
'                                    .AlternativeText = "WO:" & snpData("workorder_base_id") & "-" & snpData("workorder_sub_id") & "/" & snpData("workorder_lot_id") & " OP:" & CStr(snpData("sequence_no")) & Chr(10) & "Part ID:" & snpData("part_id") & Chr(10) & Format(snpData("start_date"), "mm/dd hh:nn") & " - " & Format(snpData("finish_date"), "mm/dd hh:nn") & Chr(10) & snpData("resource_id")
'                                End If
                            End With
                        End If
                    End If
                End If
                For i = 0 To DateDiff("d", CDate(Format(snpData("start_date"), "mm/dd/yyyy")), CDate(Format(snpData("finish_date"), "mm/dd/yyyy")))
                    intWeekDay = Weekday(DateAdd("d", i, snpData("start_date")), vbMonday) 'Column
                    'Find the row to place the information into
                    For j = 1 To 1000
                        If varWeekEnd(j) >= CDate(Format(DateAdd("d", i, snpData("start_date")), "mm/dd/yyyy")) Then
                            'Found the week for this record
                            intDataRow = intBaseRow + j

                            If intDataRow > intBaseRowMax Then
                                intBaseRowMax = intDataRow
                            End If
                            Exit For
                        End If
                    Next j
                    If (i = 0) And (i = DateDiff("d", CDate(Format(snpData("start_date"), "mm/dd/yyyy")), CDate(Format(snpData("finish_date"), "mm/dd/yyyy")))) Then
                        'Need to include the start time and the end time
                        strLine = Format(snpData("start_date"), "hh:nn") & " - " & Format(snpData("finish_date"), "hh:nn") & "  " & snpData("part_id")
                    Else
                        If i = 0 Then
                            'Need to include the start time
                            strLine = Format(snpData("start_date"), "hh:nn") & " - C0:00" & "  " & snpData("part_id")
                        Else
                            If i = DateDiff("d", CDate(Format(snpData("start_date"), "mm/dd/yyyy")), CDate(Format(snpData("finish_date"), "mm/dd/yyyy"))) Then
                                'Need to include the end time
                                strLine = "C0:00" & " - " & Format(snpData("finish_date"), "hh:nn") & "  " & snpData("part_id")
                            Else
                                'Operation is continuing through this date
                                strLine = "C0:00" & " - C0:00" & "  " & snpData("part_id")
                            End If
                        End If
                    End If
                    strLine = strLine & "  " & snpData("workorder_base_id")
'                    If snpData("workorder_sub_id") <> "0" Then
'                        strLine = strLine & "-" & snpData("workorder_sub_id")
'                    End If
                    strLine = strLine & "/" & snpData("workorder_lot_id")
                    strLine = strLine & " OP " & Format(snpData("operation_seq_no"))

                    If Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value = "" Then
                        'Writing into a new cell
                        Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value = strLine
                    Else
                        'Writing into a cell already containing data
                        Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value = Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value & Chr(10) & strLine
                    End If
                Next i
                snpData.MoveNext
            Loop

            If intBaseRow > 10 Then
                'Write out the week start dates for the last resource
                For i = intBaseRow To intBaseRowMax - 1
                    Sheets("ShopCalendar").Cells(i + 1, 1).Value = Format(varWeekStart(i - intBaseRow + 1), "mm/dd/yyyy")
                Next i

                Sheets("ShopCalendar").Range("B" & Format(intBaseRow) & ":H" & Format(intBaseRowMax)).Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlEdgeTop)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlEdgeBottom)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlEdgeRight)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlInsideVertical)
                    .Weight = xlThin
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .Weight = xlThin
                End With
            End If
        End If
        snpData.Close
    End If

    Sheets("ShopCalendar").Rows("10:" & Format(intBaseRowMax)).VerticalAlignment = xlTop

    Sheets("ShopCalendar").PageSetup.PrintArea = "$A$13:$H$" & Format(intBaseRowMax)
    With Sheets("ShopCalendar").PageSetup
        .CenterFooter = "Generated " & Format(Now, "mm/dd/yyyy hh:nn")
        .RightFooter = "Page &P of &N"
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintGridlines = False
        .Orientation = xlLandscape
         '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 300
    End With

    Sheets("ShopCalendar").Range("B2").Select
    ActiveWindow.FreezePanes = True

    Sheets("ShopCalendar").Columns("B:H").Select
    Selection.ColumnWidth = 44
    Selection.WrapText = True

    Sheets("ShopCalendar").Columns("A:A").ColumnWidth = 10.43
    Sheets("ShopCalendar").Range("A13").Select
    Application.ScreenUpdating = True

    Set snpData = Nothing
    Set comData = Nothing
End Sub

With the above code added, the Draw Calendar button should now work.  Click the Draw Calendar button, the output should look something like what you see below:

A second tab is added to the worksheet that shows a graphical overview, with cyan colored bars representing operations that will complete before the work order due date and red colored bars representing operations that will complete after the work order due date:

I may post a follow-up at some point that shows how to generate an enhanced Windows metafile (EMF) which shows the graphical view of the resource utilization.





Excel – The Graphical Master of Oracle Foreign Keys

30 12 2009

December 30, 2009

Foreign keys… those practical rules that help maintain data integrity between parent and child tables, allow for table eliminations in queries beginning with Oracle release 10.2.0.1, and provide the potential for the optimizer to generate additional predicates during query optimization for better cardinality estimates.

Those benefits all sound like they might be helpful to someone, but what good are they for the average person (I mean the average developer)?  Foreign keys are great for generating abstract art (note that I am a poor judge of art), with a bunch of odd writing all over the place.

This example demonstrates how to query an Excel spreadsheet as if it were a database.  The results of the queries are used to build a graphical model of the relationships between the tables based on the foreign key relationships that are established in the database.  Excel 2003 limits text boxes to no more than 255 characters, so use Excel 2007 or later for this example, if possible.

First, we need to build the source Excel spreadsheet that will act as the database that will be queried by the second Excel spreadsheet.  The source Excel spreadsheet will have two worksheets (tabs) named “Data Dict Tables” and “Data Dict Foreign Keys”.  Use the Microsoft Query Tool, or another approach to bring in the data from the Oracle data dictionary.  The queries for each of those worksheets follows:

Data Dict Tables

SELECT
  DT.OWNER,
  DT.TABLE_NAME,
  DTC.COLUMN_NAME,
  DTC.DATA_TYPE,
  DTC.DATA_LENGTH,
  DTC.DATA_PRECISION,
  DTC.DATA_SCALE,
  DTC.NULLABLE,
  DTC.COLUMN_ID,
  DT.TABLESPACE_NAME,
  DTCC.COMMENTS TABLE_COMMENTS,
  SUBSTR(DCC.COMMENTS,1,255) COLUMN_COMMENTS
FROM
  DBA_TABLES DT,
  DBA_TAB_COLUMNS DTC,
  DBA_TAB_COMMENTS DTCC,
  DBA_COL_COMMENTS DCC
WHERE
  DT.OWNER=DTC.OWNER
  AND DT.TABLE_NAME=DTC.TABLE_NAME
  AND DT.OWNER=DTCC.OWNER(+)
  AND DT.TABLE_NAME=DTCC.TABLE_NAME(+)
  AND DTC.OWNER=DCC.OWNER(+)
  AND DTC.TABLE_NAME=DCC.TABLE_NAME(+)
  AND DTC.COLUMN_NAME=DCC.COLUMN_NAME(+)
ORDER BY
  DT.OWNER,
  DT.TABLE_NAME,
  DTC.COLUMN_ID;

— 

Data Dict Foreign Keys

SELECT
  DC2.OWNER,
  DC2.CONSTRAINT_NAME PKEY_CONTRAINT,
  DC1.CONSTRAINT_NAME FKEY_CONTRAINT,
  DCC2.TABLE_NAME PKEY_TABLE_NAME,
  DCC2.COLUMN_NAME PKEY_COLUMN_NAME,
  DCC1.TABLE_NAME FKEY_TABLE_NAME,
  DCC1.COLUMN_NAME FKEY_COLUMN_NAME,
  DCC1.POSITION
FROM
  DBA_CONSTRAINTS DC1,
  DBA_CONSTRAINTS DC2,
  DBA_CONS_COLUMNS DCC1,
  DBA_CONS_COLUMNS DCC2
WHERE
  DC1.CONSTRAINT_TYPE='R'
  AND DC1.R_OWNER=DC2.OWNER
  AND DC1.R_CONSTRAINT_NAME=DC2.CONSTRAINT_NAME
  AND DC1.OWNER=DCC1.OWNER
  AND DC1.CONSTRAINT_NAME=DCC1.CONSTRAINT_NAME
  AND DC2.OWNER=DCC2.OWNER
  AND DC2.CONSTRAINT_NAME=DCC2.CONSTRAINT_NAME
  AND DCC1.POSITION=DCC2.POSITION
  AND DC1.OWNER='SYSADM'
ORDER BY
  DC2.OWNER,
  DCC2.TABLE_NAME,
  DCC1.TABLE_NAME,
  DCC2.POSITION;

The source spreadsheet with the data dictionary details should be saved to the root of the C:\ drive with the name C:\Data Dictionary.xls

In a second spreadsheet we are trying to build the following interface:

Next, we need to add a couple ActiveX controls to the second spreadsheet:
B3: Combo Box  with a name of cboTableName with a blank Text value
C3: Check Box  with a name of chkAliasNames with a Caption of Alias Table Names
C1: Command Button  with a name of cmdInitialize with a Caption of Initialize
A1, A3, B1 – type in the text as shown above

Once we add the macro code, clicking the Initialize button will send a query to the other spreadsheet to retrieve a list of the tables:

And with all of the code in place, selecting a table builds the abstract art:

Running down the left side is the list of columns in the selected table.  Every foreign key that is defined against the selected table will trigger a recursive lookup for child tables of the child table, with the necessary join conditions listed as well as the columns that are defined in the child table.  For instance, there is a foreign key on the CO_PRODUCT table that points back to the primary key on the PART table, and the join between the tables should be P.ID = CP.PART_ID.  The CO_PRODUCT table does not have any child tables.

Skipping down to the CUST_ORDER_LINE table, it has a foreign key that references the PART table on P.ID = COL.PART_ID.  The RECEIVABLE_LINE table has a foreign key that references the CUST_ORDER_LINE table on COL.CUST_ORDER_ID = RL.CUST_ORDER_ID AND COL.LINE_NO = RL.CUST_ORDER_LINE_NO.  The RECV_LINE_BINARY table has a foreign key that references the RECEIVABLE_LINE table on RL.INVOICE_ID = RLB.INVOICE_ID AND RL.LINE_NO = RLB.RECV_LINE_NO.  With this tool we just discovered a way to join the PART table to the RECV_LINE_BINARY by analyzing the defined foreign keys.

OK, enough fun, lets enter the code.  Right-click the worksheet name (probably Sheet1) rename the sheet to ExcelQueryOfExcel and then right-click the sheet and to select View Code.  Let’s start with making the Initialize button work:

'Need to add a reference to Microsoft ActiveX Data Objects 2.8 Library before starting
'Declare a connection object in the general section to hold the connection to the database
Dim dbExcel As New ADODB.Connection

'Declare a set of variables to hold the username and password for the database
Dim strUserName As String
Dim strPassword As String
Dim strDatabase As String

Private Function ConnectDatabase() As Integer
    Dim intResult As Integer

    On Error Resume Next

    If dbExcel.State <> 1 Then
        'Connection to the database if closed
        strDatabase = Sheets("ExcelQueryOfExcel").Cells(1, 2).Value

        strUserName = ""
        strPassword = ""

        'Connect to the database
        dbExcel.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabase & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

        dbExcel.ConnectionTimeout = 40
        dbExcel.CursorLocation = adUseClient
        dbExcel.Open

        If (dbExcel.State <> 1) Or (Err <> 0) Then
            intResult = MsgBox("Could not connect to the Excel Database." & vbCrLf & Error(Err), 16, "Excel Demo")

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

Private Sub cmdInitialize_Click()
    Dim intResult As Integer
    Dim strSQL As String
    Dim strLastTable As String
    Dim snpData As ADODB.Recordset

    On Error Resume Next

    cboTableName.Clear
    cboTableName = ""
    Sheets("ExcelQueryOfExcel").Range("A6:Z10006").Delete Shift:=xlUp

    intResult = ConnectDatabase
    strLastTable = ""

    If intResult = True Then
        Set snpData = New ADODB.Recordset

        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  *" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  [Data Dict Tables$]" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  2"     '  Sort the rows by the second column in the data source
        snpData.Open strSQL, dbExcel

        If snpData.State = 1 Then
            Do While Not snpData.EOF
                If strLastTable <> snpData("table name") Then
                    strLastTable = snpData("table name")
                    cboTableName.AddItem snpData("table name")
                End If

                snpData.MoveNext
            Loop
            snpData.Close
        Else
            intResult = MsgBox("Could not send the SQL statement to the Excel Database." & vbCrLf & Error(Err), 16, "Excel Demo")
        End If

        Set snpData = Nothing
    End If
End Sub

The above code should be sufficient for the Initialize button to work – you may need to turn off Design Mode in Excel for the button to work.

Now we need to work on the recursion when a table is selected (and the rest of the code):

Private Function FindRelatedTables(strTableName As String, lngColumn As Long, lngRow As Long, intAliasTableNames As Integer) As Long
    Dim i As Integer
    Dim lngBoxLeft As Long
    Dim lngBoxTop As Long
    Dim lngBoxWidth As Long
    Dim lngBoxHeight As Long
    Dim lngResult As Long
    Dim intTableColumns As Integer
    Dim intForeignColumns As Integer
    Dim intFlag As Integer
    Dim strOut As String
    Dim strLastTable As String
    Dim strSplit() As String  'Use to alias the table names
    Dim strPrimary As String  'Stores the aliased table primary key table name
    Dim strForeign As String  'Stores the aliased table foreign key table name
    Dim strSQL As String
    Dim snpData As ADODB.Recordset
    Dim snpDataForeign As ADODB.Recordset

    On Error Resume Next

    If intAliasTableNames = True Then
        strPrimary = ""
        strSplit = Split(strTableName, "_")

        For i = 0 To UBound(strSplit)
            strPrimary = strPrimary & Left(strSplit(i), 1)
        Next i
    End If

    Set snpDataForeign = New ADODB.Recordset
    Set snpData = New ADODB.Recordset

    strSQL = "SELECT" & vbCrLf
    strSQL = strSQL & "  *" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  [Data Dict Foreign Keys$]" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  [Pkey Table Name] = '" & strTableName & "'" & vbCrLf
    strSQL = strSQL & "ORDER BY" & vbCrLf
    strSQL = strSQL & "  [Fkey Table Name]," & vbCrLf
    strSQL = strSQL & "  [Position]"
    snpDataForeign.Open strSQL, dbExcel

    If snpDataForeign.State = 1 Then
        If Not snpDataForeign.EOF Then
            strOut = strTableName & " " & strPrimary & " :" & vbLf
            intTableColumns = 0
            intForeignColumns = 0
            strLastTable = snpDataForeign("Fkey Table Name")
            Do While Not snpDataForeign.EOF
                If intAliasTableNames = True Then
                    strForeign = ""
                    strSplit = Split(snpDataForeign("Fkey Table Name"), "_")

                    For i = 0 To UBound(strSplit)
                        strForeign = strForeign & Left(strSplit(i), 1)
                    Next i
                    'Verify that the two aliases are not identical
                    If strForeign = strPrimary Then
                        strForeign = strForeign & "F"
                    End If
                    strOut = strOut & strPrimary & "." & snpDataForeign("Pkey Column Name") & " = " & strForeign & "." & snpDataForeign("Fkey Column Name") & vbLf
                Else
                    strOut = strOut & snpDataForeign("Pkey Table Name") & "." & snpDataForeign("Pkey Column Name") & " = " & snpDataForeign("Fkey Table Name") & "." & snpDataForeign("Fkey Column Name") & vbLf
                End If

                intForeignColumns = intForeignColumns + 1

                snpDataForeign.MoveNext

                'See if we need to retrieve the table columns for the previous table
                intFlag = False
                If snpDataForeign.EOF Then
                    intFlag = True
                Else
                    If strLastTable <> snpDataForeign("Fkey Table Name") Then
                        intFlag = True
                    End If
                End If

                If intFlag = True Then
                    strSQL = "SELECT" & vbCrLf
                    strSQL = strSQL & "  *" & vbCrLf
                    strSQL = strSQL & "FROM" & vbCrLf
                    strSQL = strSQL & "  [Data Dict Tables$]" & vbCrLf
                    strSQL = strSQL & "WHERE" & vbCrLf
                    strSQL = strSQL & "  [Table Name] = '" & strLastTable & "'" & vbCrLf
                    strSQL = strSQL & "ORDER BY" & vbCrLf
                    strSQL = strSQL & "  [Column Id]"     '  Sort the rows by the second column in the data source
                    snpData.Open strSQL, dbExcel
                    If snpData.State = 1 Then
                        If Not snpData.EOF Then
                            strOut = strOut & vbLf & strLastTable & " " & strForeign & " :" & vbLf
                            intTableColumns = 0
                            Do While Not snpData.EOF
                                strOut = strOut & snpData("column name") & vbLf
                                intTableColumns = intTableColumns + 1

                                snpData.MoveNext
                            Loop
                        End If
                    End If
                    snpData.Close

                    'Create the text box
                    'Strip off the trailing CrLf
                    strOut = Left(strOut, Len(strOut) - 1)

                    lngBoxLeft = lngColumn * 200
                    lngBoxWidth = 200
                    lngBoxTop = lngRow * 20
                    lngBoxHeight = (intTableColumns + intForeignColumns + 3) * 5.5

                    With Sheets("ExcelQueryOfExcel").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight * 2 - 1))
                        With .TextFrame
                            If Application.Version <= 11 Then
                                'There is a 255 character limit on text boxes before Office 2007
                                .Characters.Text = Left(strOut, 255)
                            Else
                                .Characters.Text = strOut
                            End If
                            .Characters.Font.Size = 8
                        End With
                        .Fill.ForeColor.RGB = RGB(255 - lngColumn * 10, 255 - lngColumn * 10, 255)
                    End With

                    'With Sheets("ExcelQueryOfExcel").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight * 2 - 1))
                    '    With .TextFrame
                    '        .Characters.Text = strOut
                    '        .Characters.Font.Size = 8
                    '    End With
                    '    .Fill.ForeColor.RGB = RGB(255 - lngColumn * 10, 255 - lngColumn * 10, 255)
                    'End With

                    If lngColumn < 6 Then
                        'Only recursively call to 6 levels
                        'Recursive call into this function
                        lngResult = FindRelatedTables(strLastTable, lngColumn + 1, lngRow, intAliasTableNames)
                    End If

                    'Prepare for the next text box
                    strOut = strTableName & " " & strPrimary & " :" & vbLf
                    intTableColumns = 0
                    intForeignColumns = 0
                    lngRow = lngRow + 3
                End If
                If Not snpDataForeign.EOF Then
                    strLastTable = snpDataForeign("Fkey Table Name")
                End If

                If lngRow > 5000 Then
                    'Protection against a very long wait
                    Exit Do
                End If
            Loop
        End If
        snpDataForeign.Close
    End If

    Set snpDataForeign = Nothing
    Set snpData = Nothing
End Function

Private Sub FindTable()
    Dim intAliasTableNames As Integer
    Dim intResult As Integer
    Dim lngResult As Long
    Dim lngRow As Long
    Dim strSQL As String
    Dim strTableName As String
    Dim snpData As ADODB.Recordset

    On Error Resume Next

    intAliasTableNames = chkAliasNames.Value
    lngRow = 6

    Sheets("ExcelQueryOfExcel").Range("A" & Format(lngRow) & ":Z" & Format(lngRow + 10000)).Delete Shift:=xlUp

    If cboTableName <> "" Then
        Application.ScreenUpdating = False

        strTableName = cboTableName
        Set snpData = New ADODB.Recordset

        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  *" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  [Data Dict Tables$]" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  [Table Name] = '" & strTableName & "'" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  [Column Id]"     '  Sort the rows by the second column in the data source
        snpData.Open strSQL, dbExcel
        If snpData.State = 1 Then
            Sheets("ExcelQueryOfExcel").Cells(lngRow, 1).Value = strTableName
            Sheets("ExcelQueryOfExcel").Cells(lngRow, 1).Font.Bold = True
            lngRow = lngRow + 1

            If Not snpData.EOF Then
                Do While Not snpData.EOF
                    Sheets("ExcelQueryOfExcel").Cells(lngRow, 1).Value = snpData("column name")
                    lngRow = lngRow + 1

                    snpData.MoveNext

                    'Safety net
                    If lngRow > 1000 Then
                        Exit Do
                    End If
                Loop

                lngResult = FindRelatedTables(strTableName, 1, 5, intAliasTableNames)
            End If
            snpData.Close
        Else
            intResult = MsgBox("Could not send the SQL statement to the Excel Database." & vbCrLf & Error(Err), 16, "Excel Demo")
        End If

        Set snpData = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub cboTableName_Click()
    FindTable
End Sub

Private Sub cboTableName_GotFocus()
    cboTableName.SelStart = 0
    cboTableName.SelLength = Len(cboTableName)
End Sub

Private Sub cboTableName_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If (KeyCode = 13) Or (KeyCode = 8  ) Then
        FindTable
    End If
End Sub

Private Sub chkAliasNames_Click()
    FindTable
End Sub

I will not try here to explain how all of the above code works.  I created this demonstration for a presentation that I gave a couple months ago.  It really should be easy to understand if you step through the code starting with the cboTableName_Click Sub.





Extract the First 4400 Images from Excel 2003 (and Above) and Transfer to a Database Table

28 12 2009

December 28, 2009

This code sample is an Excel 2003/2007 macro that extracts all of the named toolbar button pictures from Excel 2003/2007, transfers those pictures to an Oracle database (stored in a BLOB), and then retrieves each of the pictures and displays the pictures on an Excel worksheet.

First, we need to create a table to hold the pictures:

CREATE TABLE EXCEL2003_TOOLBAR_PICTURES (
  PICTURE_NAME VARCHAR2(60),
  PICTURE_SIZE NUMBER,
  PICTURE BLOB,
  PRIMARY KEY(PICTURE_NAME));

See the instructions in the previous blog article to enable macro support in Excel 2007 and add a reference to the ActiveX Data Objects in Excel 2003 and above.

The Excel macro code follows:

Private Sub ExtractAllImages2003()
    'Adapted from an example by John Walkenbach
    '    http://www.dailydoseofexcel.com/archives/2006/11/16/displaying-commandbar-faceid-images/
    'See also http://support.microsoft.com/kb/286460
    Dim i As Integer
    Dim intResult As Integer
    Dim intFileNum2 As Integer
    Dim lngNumPics As Long
    Dim sglX As Single
    Dim sglY As Single
    Dim strName As String
    Dim strSQL As String
    Dim strDatabase As String
    Dim strUserName As String
    Dim strPassword As String
    Dim bytPicture() As Byte

    Dim tbNewToolbar As CommandBar
    Dim tbcNewControl As CommandBarButton
    Dim picPicture As stdole.IPictureDisp
    Dim picMask As stdole.IPictureDisp
    Dim snpData As New ADODB.Recordset
    Dim dynData As New ADODB.Recordset
    Dim dbDatabase As New ADODB.Connection

    On Error Resume Next

    'Remove all of the previously created sheet
    Application.DisplayAlerts = False
    Sheets("BuiltInImages2003").Delete

    Sheets.Add
    ActiveSheet.Name = "BuiltInImages2003"

    'Delete existing TempFaceIds toolbar if it exists
    Application.CommandBars("TempFaceIds").Delete

    'Add an empty toolbar
    Set tbNewToolbar = Application.CommandBars.Add(Name:="TempFaceIds")

    'Create an object to act as a command bar control
    Set tbcNewControl = tbNewToolbar.Controls.Add(Type:=msoControlButton)

    Application.DisplayAlerts = True

    If Len(Dir("C:\ExcelBuiltInImages2003", vbDirectory)) < 4 Then
        'Create the folder to hold the exported pictures
        MkDir "C:\ExcelBuiltInImages2003"
    End If

    Err = 0

    strDatabase = "MyDB" 'From tnsnames.ora
    strUserName = "MyUserID"
    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")
    End If

    'The table definition
    'CREATE TABLE EXCEL2003_TOOLBAR_PICTURES (
    '  PICTURE_NAME VARCHAR2(60),
    '  PICTURE_SIZE NUMBER,
    '  PICTURE BLOB,
    '  PRIMARY KEY(PICTURE_NAME));

    If Err = 0 Then
        'Remove pictures that were previously brought in
        strSQL = "DELETE FROM EXCEL2003_TOOLBAR_PICTURES"
        dbDatabase.Execute strSQL

        dbDatabase.BeginTrans

        'Prepare to add the new pictures to the database
        strSQL = "SELECT"
        strSQL = strSQL & "  PICTURE_NAME," & vbCrLf
        strSQL = strSQL & "  PICTURE_SIZE," & vbCrLf
        strSQL = strSQL & "  PICTURE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  EXCEL2003_TOOLBAR_PICTURES"
        dynData.Open strSQL, dbDatabase, adOpenKeyset, adLockOptimistic, adCmdText

        For i = 1 To 4400  'Maximum in Excel 2003 is around 10033
            'Set the picture on the command bar control to picture number i
            tbcNewControl.FaceId = i

            'Transfer the pictures from the command bar control to local variables
            Set picPicture = tbcNewControl.Picture
            Set picMask = tbcNewControl.Mask

            'Save the pictures to disk
            strName = "FaceID " & Format(i, "0000") & ".bmp"
            Application.StatusBar = strName
            stdole.SavePicture picPicture, "C:\ExcelBuiltInImages2003\temp.bmp"

            'Create a new row in the table
            dynData.AddNew
            dynData("picture_name") = strName
            dynData("picture_size") = FileLen("C:\ExcelBuiltInImages2003\temp.bmp")

            'Read the picture into the table
            intFileNum2 = FreeFile
            Open "C:\ExcelBuiltInImages2003\temp.bmp" For Binary As #intFileNum2
            'Prepare a variable of byte data type to hold the picture read from disk
            ReDim bytPicture(FileLen("C:\ExcelBuiltInImages2003\temp.bmp"))
            Get #intFileNum2, , bytPicture
            Close #intFileNum2

            'Write the picture into the table and save the row
            dynData.Fields("picture").AppendChunk bytPicture
            dynData.Update

            'Save the mask picture for the toolbar button
            stdole.SavePicture picMask, "C:\ExcelBuiltInImages2003\temp.bmp"
            strName = "FaceID " & Format(i, "0000") & " Mask.bmp"

            'Create a new row in the table
            dynData.AddNew
            dynData("picture_name") = strName
            dynData("picture_size") = FileLen("C:\ExcelBuiltInImages2003\temp.bmp")

            'Read the picture into the table
            intFileNum2 = FreeFile
            Open "C:\ExcelBuiltInImages2003\temp.bmp" For Binary As #intFileNum2
            'Prepare a variable of byte data type to hold the picture read from disk
            ReDim bytPicture(FileLen("C:\ExcelBuiltInImages2003\temp.bmp"))
            Get #intFileNum2, , bytPicture
            Close #intFileNum2

            'Write the picture into the table and save the row
            dynData.Fields("picture").AppendChunk bytPicture
            dynData.Update

            'Free the memory ffrom the local variables
            Set picPicture = Nothing
            Set picMask = Nothing

            'Allow Excel to process events every 160 pictures
            If i Mod 160 = 0 Then
                Application.ScreenUpdating = True
                DoEvents
                Application.ScreenUpdating = False
            End If
        Next i

        dbDatabase.CommitTrans
        dynData.Close

        'Delete the picture from the folder
        Kill "C:\ExcelBuiltInImages2003\temp.bmp"

        'Retrieve the pictures from the database and display in Excel
        i = 0
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  PICTURE_NAME," & vbCrLf
        strSQL = strSQL & "  PICTURE_SIZE," & vbCrLf
        strSQL = strSQL & "  PICTURE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  EXCEL2003_TOOLBAR_PICTURES" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  PICTURE_NAME"
        snpData.Open strSQL, dbDatabase

        If Not (snpData.EOF) Then
            Do While Not (snpData.EOF)
                i = i + 1
                Application.StatusBar = snpData("picture_name")

                'Retrieve the picture from the database and write to a file
                intFileNum2 = FreeFile
                ReDim bytPicture(snpData("picture_size"))
                bytPicture = snpData("picture")

                Open "C:\ExcelBuiltInImages2003\" & snpData("picture_name") For Binary As #intFileNum2
                Put #intFileNum2, , bytPicture
                Close #intFileNum2

                'There will be 20 pictures across the page, so identify the top left position of the picture
                sglX = ((i - 1) Mod 40) * 18
                sglY = Int((i - 1) / 40) * 18

                'Create the shape object and load the picture that was saved from the image object
                With Sheets("BuiltInImages2003").Shapes.AddShape(Type:=msoShapeRectangle, Left:=sglX, Top:=sglY, Width:=16, Height:=16)
                    .Line.Visible = False
                    .Fill.UserPicture "C:\ExcelBuiltInImages2003\" & snpData("picture_name")
                    .AlternativeText = snpData("picture_name")
                End With

                'Allow Excel to refresh the screen as every four rows complete
                If i Mod 160 = 0 Then
                    Application.ScreenUpdating = True
                    DoEvents
                    Application.ScreenUpdating = False
                End If

                snpData.MoveNext
            Loop
            snpData.Close
        End If
    End If

    Application.CommandBars("TempFaceIds").Delete

    Application.ScreenUpdating = True
    Application.StatusBar = ""
    dbDatabase.Close

    'Clean up
    Set snpData = Nothing
    Set dynData = Nothing
    Set dbDatabase = Nothing
End Sub

When the macro runs, it saves each of the built-in toolbar icons to a file named temp.bmp, and then inserts a row into the database table with the temp.bmp picture and the mask for the temp.bmp picture that will allow creating a semi-transparent button image.  Once all of the pictures are stored in the database, a query is run to retrieve each of the pictures, create a file in the ExcelBuiltInImages2003 folder for that picture, and then display the picture in Excel.  The screen is refreshed after every 160 pictures are displayed.  Note that most of the built-in toolbar icons are designed to be viewed at a size of 16 pixels by 16 pixels, so the icons are extracted at that size.  The picture filenames are written to the Alt Text property of each picture, which may be viewed by right-clicking a picture and selecting Size and Properties…

After the macro runs, the new worksheet will look something like the picture below:

Since the pictures are also saved to a file, they are ready to be used for other purposes:








Follow

Get every new post delivered to your Inbox.

Join 139 other followers