Creating PivotTable-reports from VB 6.0

[XL-Dennis]

Hi all,

Creating reports in Excel is a common task and also to retrieve data from databases.

For several reason we may decide to create a standalone reporttool in VB instead of doing it from inside Excel.

When setting up reports with the Pivottable and particular if we want to have the option to update the table ( i e retrieve updated data from the source) we must be aware of that there exist certain limitations to use a classic ADO-approach and therefore are (still) forced to use the ODBC-approach.

Please see Populate pivottables using ADO

In the example early binding is used and therefore it require that we set references to the following library:

* Microsoft Excel 9.0 or later

What we need:
* Microsoft Visual Basic 6.0
* Microsoft Excel 2000 and later
* The example database Northwind.mdb

Option Explicit 
 
Dim xlApp As Excel.Application 
Dim xlWbook As Excel.Workbook 
Dim xlWSheet As Excel.Worksheet 
Dim xlptCache As Excel.PivotCache 
Dim xlptTable As Excel.PivotTable 
 
Const stCon As String = "ODBC;DSN=MS Access Database;" & _ 
"DBQ=C:\Northwind.mdb;DefaultDir=C:\;" & _ 
"DriverId=25;FIL=MS Access;" & _ 
"MaxBufferSize=2048;PageTimeout=5;" 
 
 
Const stSQL As String = "SELECT ShipCountry, " & _ 
"COUNT(Freight) AS [# Of Shipments], " & _ 
"SUM(Freight) AS [Total Freight] " & _ 
"FROM Orders " & _ 
"GROUP BY ShipCountry;" 
 
 
Public Function Create_PivotTable_Report(ByVal stFilename As String) 
    Dim bStarted As Boolean 
     
     'If a session of Excel is already running then grab it.
    On Error Resume Next 
    Set xlApp = GetObject(, "Excel.Application") 
    On Error Goto 0 
     
     'Otherwise instantiate a new instance.
     'Keep in mind that no active Add-ins will be available unless they are
     'of the type COM.
    If xlApp Is Nothing Then 
         'Set the flag to remember who have started the session.
        bStarted = True 
        Set xlApp = New Excel.Application 
    End If 
     
     'Create a new workbook with one worksheet only.
    Set xlWbook = xlApp.Workbooks.Add(xlWBATWorksheet) 
     
    With xlWbook 
        Set xlWSheet = .Worksheets(1) 
        Set xlptCache = .PivotCaches.Add(SourceType:=xlExternal) 
    End With 
     
     'Populate the Pivotcache.
    With xlptCache 
        .Connection = stCon 
        .CommandText = stSQL 
        .CommandType = xlCmdSql 
    End With 
     
     'Create the Pivottable.
    Set xlptTable = xlWSheet.PivotTables.Add( _ 
    PivotCache:=xlptCache, _ 
    TableDestination:=xlWSheet.Range("D4"), _ 
    TableName:="PT_Report") 
     
     'Setup the pivottable.
    With xlptTable 
        .ManualUpdate = True 
        .PivotFields("ShipCountry").Orientation = xlRowField 
        .PivotFields("# Of Shipments").Orientation = xlDataField 
        .PivotFields("Total Freight").Orientation = xlDataField 
        .Format xlTable2 
        .ManualUpdate = False 
        .ManualUpdate = True 
    End With 
     
     'Save the created workbook.
    xlWbook.SaveAs stFilename 
     
     'If this procedure have started Excel then the UserControl of Excel must be
     'set to True and we need to make Excel visible.
    If bStarted Then 
        With xlApp 
            .Visible = True 
            .UserControl = True 
        End With 
    End If 
     
     'Switch to Excel.
    AppActivate (xlApp) 
     
     'Release the objects from memory.
    Set xlptTable = Nothing 
    Set xlptCache = Nothing 
    Set xlWSheet = Nothing 
    Set xlWbook = Nothing 
    Set xlApp = Nothing 
     
End Function