Private conODS As ADODB.Connection
Public Sub PassThroughTest()
Dim ThisDB As DAO.Database
Dim QDef As DAO.QueryDef
Dim MyField As DAO.Field
Dim strFieldList As String
Set ThisDB = CurrentDb()
Set conODS = New ADODB.Connection
conODS.Open "Driver={Oracle73 Ver 2.5};DSN=aaa;UID=bbb;PWD=ccc;DBQ=ddd;ASY=OFF;"
For Each QDef In ThisDB.QueryDefs
If QDef.Connect <> "" Then 'It's a pass-through
For Each MyField In QDef.Fields
strFieldList = strFieldList & vbCrLf & ParentTable(MyField.Name, QDef.SQL) & "." & MyField.Name
Next MyField
End If
Next QDef
Debug.Print strFieldList
End Sub
Public Function ParentTable(ByVal strFieldName As String, ByVal strQuerySQL As String) As String
On Error GoTo TrapErr
Dim rstDataDictionary As ADODB.Recordset
Dim strSQL As String
Dim strList As String
Dim astrMultiples() As String
strSQL = "SELECT TABLE_NAME FROM ALL_TAB_COLUMNS WHERE COLUMN_NAME='" & strFieldName & "';"
Set rstDataDictionary = New ADODB.Recordset
rstDataDictionary.CursorLocation = adUseClient 'This is required to use the .MoveLast method. Defaults to adUseServer
rstDataDictionary.Open strSQL, conODS, adOpenStatic, adLockReadOnly
'Ensure .RecordCount property returns correct value. Is this necessary on ADO recordsets??
rstDataDictionary.MoveLast
rstDataDictionary.MoveFirst
If rstDataDictionary.RecordCount = 1 Then 'Only one table in ODS contains this field. Good news!
ParentTable = rstDataDictionary!TABLE_NAME
ElseIf rstDataDictionary.RecordCount > 1 Then 'Bugger. Multiple tables in ODS have this field. Now we need to find the relevant one.
With rstDataDictionary
Do While Not .EOF
If InStr(1, strQuerySQL, !TABLE_NAME, vbTextCompare) > 0 Then
strList = strList & "," & !TABLE_NAME
End If
.MoveNext
Loop
strList = Right$(strList, Len(strList) - 1)
astrMultiples = Split(strList, ",")
If UBound(astrMultiples()) > 0 Then 'More than one table
ParentTable = "MULTIPLES"
Else
ParentTable = astrMultiples(0)
End If
End With
Else 'Table count = zero. This should never happen...
ParentTable = "UNKNOWN"
End If
ExitHere:
Exit Function
TrapErr:
ParentTable = "UNEXPECTED_EXCEPTION"
Resume ExitHere
End Function