Sub Create_SelectQuery()
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 = "SELECT Employees.* FROM Employees WHERE Employees.City='London';"
strQryName = "London Employees"
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.Views.Append strQryName, cmd
ExitHere:
Set cmd = Nothing
Set cat = Nothing
MsgBox "The procedure completed successfully.", _
vbInformation, "Create Select Query"
Exit Sub
ErrorHandler:
If InStr(Err.Description, "already exists") Then
cat.Views.Delete strQryName
Resume
Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End If
End Sub