Make pass through queries with ADOX - Example

[PeasNCarrots]

Sub GetGSSData()

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim arrDSN(1) As String
Dim intArr As Integer
Dim Catalog As ADOX.Catalog
Dim Command As New ADODB.Command

'Set variables
Set rst = New ADODB.Recordset
Set conn = New ADODB.Connection
Set Catalog = New ADOX.Catalog
Set Command = New ADODB.Command

'Add DSN Names to Array
arrDSN(0) = "Chema" 'Chelmsford Sever
arrDSN(1) = "WOR" 'Worcester Server

'SQL String for GSS Data
strSQL = "SELECT TLDSEU_CUR.OUB_SRT_DT, TOUOWSN_CUR.PKG_TCK_NR," _
& " TOUOWSN_CUR.PKL_SN_ACT_TS, TOUOWSN_CUR.USR_NR, TOUOWSN_CUR.SRT_TYP_CD," _
& " TOUOWSN_CUR.DAT_CP_MTH_CD, TLDSEU_CUR.ULO_TYP_CD, TLDSEU_CUR.ULO_NR," _
& " TLDSEU_CUR.DTN_OGZ_NR, TLDSEU_CUR.DTN_SRT_TYP_CD, TLDSEU_CUR.SVC_TYP_CD" _
& " FROM TOUOWSN_CUR INNER JOIN TLDSEU_CUR ON TOUOWSN_CUR.LD_REF_NR = TLDSEU_CUR.LD_REF_NR" _
& " WHERE ((TLDSEU_CUR.OUB_SRT_DT) = '20040727') AND ((TLDSEU_CUR.DTN_OGZ_NR) = '00209')" _
& " AND (TLDSEU_CUR.DTN_SRT_TYP_CD = '01' OR TLDSEU_CUR.DTN_SRT_TYP_CD = '06')"


For intArr = 0 To 1

Set Catalog = New ADOX.Catalog
Set Command = New ADODB.Command
Catalog.ActiveConnection = CurrentProject.Connection
Set Command.ActiveConnection = Catalog.ActiveConnection

Command.CommandText = strSQL
Command.Properties("Jet OLEDB:ODBC Pass-Through Statement") = True


'connection for passthrough query
Command.Properties _
("Jet OLEDBass Through Query Connect String") = _
"ODBC;DSN=" & arrDSN(intArr) & ";UID=ucr_readonly;PWD=readonly;DATABASE=D685UCR;"

'Delete and recreate passthrough with selected parameters
Catalog.Procedures.Delete "GSS_" & arrDSN(intArr)
Catalog.Procedures.Append "GSS_" & arrDSN(intArr), Command


Set Catalog = Nothing
Set Command = Nothing

Next

End Sub