Realizar una nueva consulta o cambiar el SQL de una consulta usando VBA

Vba

Módulo estándar

' module name: mod_Query_Make_s4p
'*************** Code Start ***************************************************
' Purpose  : make a query or change the SQL of a query
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'--------------------------------------------------------------------------------
'                              Query_Make_s4p
'--------------------------------------------------------------------------------'
Sub Query_Make_s4p( _ 
   ByVal qName As String _ 
   ,ByVal pSql As String _ 
   ) 
'crystal (strive4peace) 220127
' if query already exists, update the SQL
' if not, create the query

   On Error GoTo Proc_Err 
   
   Dim db As DAO.Database 
   Set db = CurrentDb 
   
   With db 
      'Query: Type = 5  
      If Nz(DLookup( "(Name)", "MSysObjects", _ 
          "(Name)='" & qName _ 
          &  "' And (Type)=5"), "") =  "" Then 
          .CreateQueryDef qName,pSql 
      Else 
         'if query is open, close it
         On Error Resume Next 
         DoCmd.Close acQuery,qName,acSaveNo 
         On Error GoTo Proc_Err 
         .QueryDefs(qName).SQL = pSql 
      End If 
      .QueryDefs.Refresh 
      'refresh database window
      Application.RefreshDatabaseWindow 
   End With 
   
Proc_Exit: 
   On Error GoTo 0 
   Set db = Nothing 
   Exit Sub  
   
Proc_Err: 
   MsgBox Err.Description,, _ 
     "ERROR " & Err.Number &  "  Query_Make"
    
   Resume Proc_Exit 

   'if you want to single-step code to find error, CTRL-Break at MsgBox
   'then set this to be the next statement
   Resume 
End Sub 
'*************** Code End *****************************************************

‘ El código se generó con colores utilizando el complemento gratuito Color Code para Access.