Create an updatable query from multiple AS400 IBMi connections
My attempt was to create a simple pivot table on the fly from multiple tables from the AS400 IBMi. This has been achieved, but the pivot table is not "updated".
So, I started looking for posts about creating connections programmatically and came up with the example below, which is updated, but in only one table:
ActiveWorkbook.Connections.AddFromFile "N:\apps\excel\connections\PRD IS.odc"
With ActiveWorkbook.Connections("PRD IS").ODBCConnection
.BackgroundQuery = True
.CommandText = Array("SELECT * FROM ""PRD"".""Y2K"".""IS""")
.CommandType = xlCmdSql
.Connection = "ODBC;DSN=s11111111;"
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = "N:\apps\excel\connections\PRD IS.odc"
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("PRD IS")
.Name = "PRD IS"
End With
ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
ActiveWorkbook.Connections("PRD IS"), Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:=ActiveCell, TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14
Is it possible to use two connections, combine them and create a final result that is updated?
Second connection:
ActiveWorkbook.Connections.AddFromFile "N:\apps\excel\connections\PRD PM.odc"
With ActiveWorkbook.Connections("PRD PM").ODBCConnection
.BackgroundQuery = True
.CommandText = Array("SELECT * FROM ""PRD"".""Y2K"".""PM""")
.CommandType = xlCmdSql
.Connection = "ODBC;DSN=s111111111;"
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = "N:\apps\excel\connections\PRD PM.odc"
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("PRD PM")
.Name = "PRD PM"
End With
Current working code:
Sub CreatePivotTable()
'Declare variables
Dim Conn As ADODB.Connection
Dim Cmd As ADODB.Command
Dim Param As ADODB.Parameter
Dim rs As ADODB.Recordset
Set Conn = New ADODB.Connection
Set Cmd = New ADODB.Command
Set rs = New ADODB.Recordset
'Open Connection'
Conn.ConnectionString = "DSN=s11111111;"
Conn.Open
'Set and Excecute SQL Command'
Set Cmd.ActiveConnection = Conn
Cmd.CommandText = "SELECT ISWH as WH,ISPART as Part,PMDESC as Description,ISCF01 As AC, PMPCLS As PC, PMPLIN As PL" & _
" FROM Y2K.IS LEFT JOIN Y2K.PM ON Y2K.IS.ISPART = Y2K.PM.PMPART" & _
" WHERE(ISWH) in ('XX')" & _
" AND (ISCF01) not in ('B','D')" & _
" AND (PMPLIN) in ('YY')" & _
" AND (PMPCLS) like ('Z%')"
Cmd.CommandType = adCmdText
'Open Recordset'
Set rs.Source = Cmd
rs.Open
'Create a PivotTable cache and report.
Set objPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set objPivotCache.Recordset = rs
objPivotCache.CreatePivotTable TableDestination:=ActiveCell, TableName:="PivotTable1"
With ActiveSheet.PivotTables("PivotTable1")
.SmallGrid = False
With .PivotFields("WH")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Part")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("PL")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("PC")
.Orientation = xlDataField
.Position = 1
End With
End With
End Sub
+3
source to share
1 answer
Ok I figured it out. Instead of adding existing connections, I added a new one and defined it.
"Test" is the name of the connection
"x" is the description
"Conn" is the connection string
"Cmdarray" is the sql
Sub CreatePivotTable()
Dim Cmdarray
Dim Conn
Cmdarray = Array("SELECT ISWH as WH, ISPART as Part,PMDESC as Description, ISCF01 as AC FROM ""PRD"".""Y2K"".""IS"" LEFT JOIN ""PRD"".""Y2K"".""PM"" ON ""PRD"".""Y2K"".""IS"".ISPART = ""PRD"".""Y2K"".""PM"".PMPART WHERE (ISWH) IN ('XX')")
Conn = "ODBC;DSN=s111111111;"
ActiveWorkbook.Connections.Add "Test", "x", Conn, Cmdarray
ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
ActiveWorkbook.Connections("Test"), Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:=ActiveCell, TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14
End Sub
0
source to share