Function CreateSPT(SPTQueryName As String, strSQL As String, passStatus As Integer)
Dim cat As Object
Dim cmd As Object
On Error GoTo ErrorHandler
Set cat = CreateObject("ADOX.Catalog")
Set cmd = CreateObject("ADODB.Command")
cat.ActiveConnection = CurrentProject.Connection
Set cmd.ActiveConnection = cat.ActiveConnection
cmd.CommandText = strSQL
cmd.Properties("Jet OLEDB:ODBC Pass-Through Statement") = True
cmd.Properties _
("Jet OLEDB:Pass Through Query Connect String") = SetConnectionString(passStatus)
cat.Procedures.Append SPTQueryName, cmd
Set cat = Nothing
Set cmd = Nothing
Exit Function
ErrorHandler:
' If Query already exists, delete it.
cat.Procedures.Delete SPTQueryName
Resume
End Function