vba - uso - La transferencia de paso pierde los cambios realizados en SQL

recordset vba excel

Question

Tengo una consulta de paso MyPassThru . Esta es una versión simplificada del SQL de la consulta:

SET NOCOUNT ON
DECLARE @FromDate datetime = ''1/25/2014''
DECLARE @ThruDate datetime = ''3/1/2014''
SELECT *
FROM MtgDailyTrans M
WHERE M.TransDate >= @FromDate
AND M.TransDate <= @ThruDate

Necesito hacer cambios a los parámetros @FromDate y @ThruDate. Escribí la siguiente función para hacer esto ( fuente para RegExReplace ):

Private gDb As DAO.Database
Function Db() As DAO.Database
If gDb Is Nothing Then Set gDb = CurrentDb
Set Db = gDb
End Function
Sub MyPassThruSetDates(FromDate As Date, ThruDate As Date)
Const FromPattern As String = "(@FromDate datetime = '')([/d/]+)''"
Const ThruPattern As String = "(@ThruDate datetime = '')([/d/]+)''"
Dim qd As DAO.QueryDef
Set qd = Db.QueryDefs("MyPassThru")
qd.SQL = RegExReplace(FromPattern, qd.SQL, "$1" & Format(FromDate, "m/d/yyyy") & "''")
qd.SQL = RegExReplace(ThruPattern, qd.SQL, "$1" & Format(ThruDate, "m/d/yyyy") & "''")
Set qd = Nothing
End Sub

El problema es que cuando realizo cambios en el SQL para MyPassThru y luego ejecuto el procedimiento MyPassThruSetDates() , los cambios que realicé en el SQL se retrotraen. ¿Por qué?

Answer 1

La razón por la que esto sucede es que el objeto Db persistente está almacenando en caché una copia de QueryDef y sus propiedades (para incluir la propiedad .SQL). Si llama a MyPassThruSetDates , luego realiza un cambio en el SQL para MyPassThru y luego llama a MyPassThruSetDates nuevamente, el SQL original sobrescribe cualquier cambio realizado desde la llamada original a MyPassThruDates .

La solución es actualizar la colección QueryDefs para garantizar que esté utilizando los valores más actuales:

Sub MyPassThruSetDates(FromDate As Date, ThruDate As Date)
Const FromPattern As String = "(@FromDate datetime = '')([/d/]+)''"
Const ThruPattern As String = "(@ThruDate datetime = '')([/d/]+)''"
Dim qd As DAO.QueryDef
Db.QueryDefs.Refresh '' <--- This is the key!!!
Set qd = Db.QueryDefs("MyPassThru")
qd.SQL = RegExReplace(FromPattern, qd.SQL, "$1" & Format(FromDate, "m/d/yyyy") & "''")
qd.SQL = RegExReplace(ThruPattern, qd.SQL, "$1" & Format(ThruDate, "m/d/yyyy") & "''")
Set qd = Nothing
End Sub

Para obtener una explicación más detallada de por qué sucede esto, consulte la siguiente rutina de prueba altamente comentada:

Sub TestDbCache()
Const QName As String = "TempQry"
Dim qd As DAO.QueryDef, db As DAO.Database
''First, we create a querydef
Set db = CurrentDb
Set qd = db.CreateQueryDef(QName, "SELECT ''original''")
Debug.Print qd.SQL ''--> SELECT ''original'';
''Next, we update the querydef''s .SQL outside the scope of our db object
CurrentDb.QueryDefs(QName).SQL = "SELECT ''changed''"
''The querydef and db objects are unaware of the change to .SQL
Debug.Print qd.SQL ''--> SELECT ''original'';
Debug.Print db.QueryDefs(QName).SQL ''--> SELECT ''original'';
Debug.Print CurrentDb.QueryDefs(QName).SQL ''--> SELECT ''changed'';
''Refreshing the collection updates both the db and qd objects
db.QueryDefs.Refresh
Debug.Print qd.SQL ''--> SELECT ''changed'';
Debug.Print db.QueryDefs(QName).SQL ''--> SELECT ''changed'';
''Note that the .SQL is "SELECT ''changed''" when we set the NewDb object
Dim NewDb As DAO.Database
Set NewDb = CurrentDb
''We change the .SQL without refreshing the NewDb''s QueryDefs collection
CurrentDb.QueryDefs(QName).SQL = "SELECT ''changed again''"
''Since the NewDb object never cached the contents of the query,
'' it returns the correct current value of .SQL
Debug.Print NewDb.QueryDefs(QName).SQL ''--> SELECT ''changed again'';
''The other db object has not refreshed its QueryDefs collection,
'' so it is wrong once again
Debug.Print qd.SQL ''--> SELECT ''changed'';
Debug.Print db.QueryDefs(QName).SQL ''--> SELECT ''changed'';
End Sub