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.








Follow

Get every new post delivered to your Inbox.

Join 144 other followers