Sub Create_ParameterQuery()
Dim cat As ADOX.Catalog
Dim cmd As ADODB.Command
Dim strPath As String
Dim strSQL As String
Dim strQryName As String
On Error GoTo ErrorHandler
strPath = CurrentProject.Path & "\mydb.mdb"
strSQL = "Parameters [Type Country Name] Text;" & _
"SELECT Customers.* FROM Customers WHERE " _
& "Customers.Country=[Type Country Name];"
strQryName = "Customers by Country"
Set cat = New ADOX.Catalog
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath
Set cmd = New ADODB.Command
cmd.CommandText = strSQL
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