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
