Share via

PivotTable using Recordset Method Crashes with different SQL Queries

Artjom Martirosyan 1 Reputation point
2022-03-23T09:08:30.977+00:00

Hi Guys,

I am really stuck here. I tried creating a pivottable using the ADODB connection and an external Excel Sheet as a data base. With one Query it works perfectly but if I change the restriction or remove it it throws an error.

This code works:
Sub test()
'Add reference for Microsoft Activex Data Objects Library-Microsoft Activex Data Objects 6.1 Library before running the macro
Application.ScreenUpdating = False
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim w1 As Worksheet
Dim PSheet As Worksheet, DSheet As Worksheet, Fsheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long, LastCol As Long
Dim start_date As Date, end_date As Date
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String

Set PSheet = Sheets("Tabelle58")


cpath$ = "HereIsMyPathSomewhere.xlsx"
rsconn$ = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & cpath & "';" & _
            "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
Conn.Open rsconn
With PSheet

                    strSQL$ = "SELECT * FROM [Tabelle1$] Where MarketTakerCompany = 'Client Name'"

                    rs.Open strSQL, Conn, adOpenForwardOnly, adLockOptimistic, adCmdText
End With

Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal)

Set PCache.Recordset = rs

'Insert Blank Pivot Tables
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Client_Report_1")

 'Insert Row Fields
            With PSheet.PivotTables("Client_Report_1").PivotFields("MarketTakerCompany")
            .Orientation = xlRowField
            .Position = 1
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("QuoteStatus")
            .Orientation = xlColumnField
            .Position = 1
            End With

            'Insert Data Field
            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0€"
            .Name = "Volumen (in EUR)"
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Calculation = xlPercentOfRow
            .NumberFormat = "0.00%"
            .Name = "Hit Ratio (Volumen)"
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#"
            .Name = "Anzahl"
            End With
            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Function = xlCount
            .Calculation = xlPercentOfRow
            .NumberFormat = "0.00%"
            .Name = "Hit Ratio (Anzahl)"
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("CurrencyPair")
            .Orientation = xlPageField
            .Position = 1
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("Product")
            .Orientation = xlPageField
            .Position = 2
            End With

Conn.Close
Set rs = Nothing
Set Conn = Nothing
Application.ScreenUpdating = True
End Sub

This code does throw the error VBA Runtime Error 1004 "Application-defined or Object-defined Error":

Sub test()
'Add reference for Microsoft Activex Data Objects Library-Microsoft Activex Data Objects 6.1 Library before running the macro
Application.ScreenUpdating = False
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim w1 As Worksheet
Dim PSheet As Worksheet, DSheet As Worksheet, Fsheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long, LastCol As Long
Dim start_date As Date, end_date As Date
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String

Set PSheet = Sheets("Tabelle58")


cpath$ = "HereIsMyPathSomewhere.xlsx"
rsconn$ = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & cpath & "';" & _
            "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
Conn.Open rsconn
With PSheet

                    strSQL$ = "SELECT * FROM [Tabelle1$]"

                    rs.Open strSQL, Conn, adOpenForwardOnly, adLockOptimistic, adCmdText
End With

Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal)

Set PCache.Recordset = rs

'Insert Blank Pivot Tables
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Client_Report_1")

 'Insert Row Fields
            With PSheet.PivotTables("Client_Report_1").PivotFields("MarketTakerCompany")
            .Orientation = xlRowField
            .Position = 1
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("QuoteStatus")
            .Orientation = xlColumnField
            .Position = 1
            End With

            'Insert Data Field
            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0€"
            .Name = "Volumen (in EUR)"
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Calculation = xlPercentOfRow
            .NumberFormat = "0.00%"
            .Name = "Hit Ratio (Volumen)"
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#"
            .Name = "Anzahl"
            End With
            With PSheet.PivotTables("Client_Report_1").PivotFields("NotionalAmountinBaseCurrency")
            .Orientation = xlDataField
            .Function = xlCount
            .Calculation = xlPercentOfRow
            .NumberFormat = "0.00%"
            .Name = "Hit Ratio (Anzahl)"
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("CurrencyPair")
            .Orientation = xlPageField
            .Position = 1
            End With

            With PSheet.PivotTables("Client_Report_1").PivotFields("Product")
            .Orientation = xlPageField
            .Position = 2
            End With

Conn.Close
Set rs = Nothing
Set Conn = Nothing
Application.ScreenUpdating = True
End Sub

Additionally I checked the recordset and it seems like it selects the data. The error comes in the line Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Client_Report_1"). Selecting any other header apart from the MarketTakerCompany one does not work.

Please help me, best regards

Microsoft 365 and Office | Development | Other
Developer technologies | Visual Basic for Applications
0 comments No comments

Your answer

Answers can be marked as 'Accepted' by the question author and 'Recommended' by moderators, which helps users know the answer solved the author's problem.