Sub Create_PassThroughQuery()
Dim cat As ADOX.Catalog
Dim cmd As ADODB.Command
Dim myRecordset As ADODB.Recordset
Dim strPath As String
Dim strSQL As String
Dim strQryName As String
Dim strODBCConnect As String
On Error GoTo ErrorHandler
strSQL = "SELECT Customers.* FROM Customers WHERE Customers.Country='France';"
strQryName = "French Customers"
strODBCConnect = "ODBC;Driver=SQL Server;Server=yourserver\yourName;" & _
"Database=Northwind;UID=;PWD="
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = cat.ActiveConnection
.CommandText = strSQL
.Properties("Jet OLEDB:ODBC Pass-Through Statement") = True
.Properties("Jet OLEDB:Pass-Through Query Connect String") = _
strODBCConnect
End With
cat.Procedures.Append strQryName, cmd
Set cmd = Nothing
Set cat = Nothing
Exit Sub
ErrorHandler:
If InStr(Err.Description, "already exists") Then
cat.Procedures.Delete strQryName
Resume
Else
MsgBox Err.Number & ": " & Err.Description
End If
End Sub