Pivot.XLA

OLE automation can only control one application from another if both applications "speak" the same language. PIVOT needs a Microsoft Excel add-in to supplement OLE automation because Microsoft Excel's PivotTableWizard method requires an argument of the Variant data type containing an array. Since Access Basic version 2 doesn't support this, you can't invoke Microsoft Excel's PivotTableWizard method from Access.

My workaround for this problem was to create a Microsoft Excel add-in (Pivot.XLA). I explained in the previous section how to open the add-in from Access Basic. Here I cover how to create the add-in. (See the section titled "Sample Application: The WinAPI Add-In" in Chapter 9 of Developing Applications with Microsoft Office for more information on Microsoft Excel add-ins.)

The easiest way to generate code for pivot tables is to start with Microsoft Excel's macro recorder. Before trying this with any external (non-Microsoft Excel) database, register that database with the ODBC driver manager.

1. After registering the database with the ODBC driver manager, start the macro recorder by choosing Record Macro from the Tools menu. Then choose Record New Macro.

2. Choose PivotTable™ from the Data menu. Microsoft Excel opens the PivotTable Wizard, which walks you through most of the steps below.

3. In Step 1 of the PivotTable Wizard, select the type of data source. (PIVOT uses an external data source.)

4. Step 2 of the PivotTable Wizard launches Microsoft Query when you click on the Get Data button. Select the ODBC data source that you want to query (I selected the PIVOT data source), and then click the Use button.

5. Add Pivot.MDB's three tables (Categories, Products, and Suppliers) to the Query window, then perform the query. I used three fields in PIVOT: Category Name from the Categories table, Zone from the Suppliers table, and a calculated field that multiplies the two fields Unit Price and Units in Stock from the Products Table. Type the following into a field in the Query window (or in the Add Column dialog box) to perform this calculation:

6. Click the Return Data button to close Microsoft Query and return to Microsoft Excel. In Step 3 of the PivotTable Wizard, drag the fields to the place where you want them to appear in the pivot table. I positioned Category as the Row, Zone as the Column, and Sum of Expr1002. (Sum of Expr1002 is the calculated field, which I double-clicked on and renamed "Inventory Value.")

7. In the last step of the PivotTable Wizard, name the pivot table and indicate where to position it on the worksheet.

8. Click the Stop Macro button to stop recording.

Microsoft Excel records code similar to the following:


Sub RecordPivotTable()
  ActiveSheet.PivotTableWizard SourceType:=xlExternal, 
SourceData:= Array("DSN=PIVOT;DBQ=C:\PIVOT\PIVOT.MDB;
DefaultDir=C:\PIVOT;Description=for Access-Microsoft Excel pivot table
example;FIL=MS Access;JetIniPath=msacc20.ini;
SystemDB=C:\ACCESS2\SYSTEM.MDA;UID=Admin;"
"SELECT Categories.`Category Name`, Suppliers.Zone, `Unit
Price`*`Units In Stock`FROM Categories Categories, Products
Products, Suppliers Suppliers WHERE Products.`Category ID` =
Categories.`Category ID` AND Suppliers.`Supplier ID` =
Products.`Supplier ID`"), TableDestination:="R1C1",
TableName:="PivotTable3"ActiveSheet.PivotTables("PivotTable3")
.AddFields RowFields:="Category Name", ColumnFields:="Zone"
ActiveSheet.PivotTables("PivotTable3").PivotFields("Inventory
Value").Orientation = xlDataField End Sub

From Macro Recorder to Finished Product

Pivot.XLA's MakePivotTable subroutine, shown below, is quite similar to the recorded macro. I made three main changes to the macro-recorded code:

Note Remember that you have to use the References command on the Tools menu to open XLODBC.XLA in order to use Microsoft Excel's ODBC functions.


Option Explicit
Declare Function GetPrivateProfileString Lib "KERNEL" (ByVal _
    lpSectionName As String, ByVal lpEntryName As String, ByVal _
    lpDefault As String, ByVal lpReturnedString As String, ByVal _
    nSize As Integer, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "KERNEL" (ByVal _
    lpSectionName As String, ByVal lpEntryName As String, ByVal _
    lpString As String, ByVal lpFileName As String) As Integer


Sub MakePivotTable()

'ODBC connection string for PIVOT.MDB.
    Dim strConnect As String
    
'Cell to receive whole connection string from SQLOpen function.
    Dim objDummyCell As Object
    
'Connection ID returned by SQLOpen function.
    Dim iConnID As Integer
    
'All-purpose integer variable to receive return values from
'add-in and API functions.
    Dim iRet As Integer
    
'Return value of GetPrivateProfileString.
    Dim iLength As Integer
    
'Array argument for PivotTableWizard method.
    Dim ArrayConnect() As String

'Name of INI file.
    Const strINIFile = "PIVOT.INI"
    
'Turn off screen updating.
    Application.ScreenUpdating = False
    
'Get ODBC connection string from INI file.
    strConnect = String$(256, 0)
    iLength = GetPrivateProfileString("PivotTableWizardInfo", _
        "ConnectionString", "", strConnect, Len(strConnect), _
        strINIFile)

GetConnection:
    If iLength <> 0 Then
        strConnect = Left$(strConnect, iLength)
        
'If there's no connection string in the INI file, get one by 
'calling the SQLOpen function with an empty string as its first 
'argument and 3 as its final argument. This function prompts users 
'to select a database, and records the connection string in a 
'cell. (The function doesn't let you store it in a variable 
'directly). Read the connection string from the cell into 
'strConnect, clear the cell, close the database connection via 
'SQLClose, and record the connection string in the INI file for 
'future use.
    Else
        Set objDummyCell = ActiveSheet.Range("A1")
        iConnID = SQLOpen("", objDummyCell, 3)
        strConnect = objDummyCell.Value
        objDummyCell.Clear
        iRet = SQLClose(iConnID)
        iRet = WritePrivateProfileString("PivotTableWizardInfo", _
            "ConnectionString", strConnect, strINIFile)
    End If
    
    On Error GoTo PivotProblem
    
'Invoke the PivotTableWizard method for the active sheet.
'The SourceType argument constant xlExternal indicates an external
'database. The SourceData argument is an array--its first element
'is the ODBC connection string, and the remaining elements are
'the query for the pivot table data broken into chunks no longer
'than 200 characters (which is what the PivotTableWizard method
'requires). The Table Destination argument R1C1 places
'the pivot table at the upper left corner of the active sheet.
'The TableName argument assigns a name to the pivot table.
    ReDim ArrayConnect(1 To 8)
    ArrayConnect(1) = strConnect
    ArrayConnect(2) = "SELECT DISTINCTROW Categories.[Category
Name], " ArrayConnect(3) = "Suppliers.Zone, [Products]![Unit Price]*" ArrayConnect(4) = "[Products]![Units In Stock] AS [Inventory
Value] " ArrayConnect(5) = "FROM Categories INNER JOIN (Suppliers INNER
JOIN " ArrayConnect(6) = "Products ON Suppliers.[Supplier ID] = " ArrayConnect(7) = "Products.[Supplier ID]) ON Categories.
[Category ID]" ArrayConnect(8) = " = Products.[Category ID];" ActiveSheet.PivotTableWizard SourceType:=xlExternal, _ SourceData:=ArrayConnect, TableDestination:="R1C1", _ TableName:="Inventory" 'Add fields to the pivot table. This table has a single row field, '"Category Name", and a single column field, "Zone" ActiveSheet.PivotTables("Inventory").AddFields RowFields:= _ "Category Name", ColumnFields:="Zone" 'Designate "Inventory Value" as the data field, and display its 'entries with the specified number format. With ActiveSheet.PivotTables("Inventory").PivotFields _
("Inventory Value") .Orientation = xlDataField .NumberFormat = "#,##0.00_);[Red](#,##0.00)" End With ExitPivot: 'Turn screen updating on Application.ScreenUpdating = True Exit Sub PivotProblem: 'If the PivotTable Wizard method fails (Err = 1004), it 'may be because the connection string was bad. Get a good one. If Err = 1004 Then Err = 0 iLength = 0 Resume GetConnection Else MsgBox Str$(Err) & ": " & Error$() Exit Sub End If Resume ExitPivot End Sub