VBA – zmiana kwerendy z użyciem SQL

Jeżeli chcemy aby nasza hipotetyczna kwerenda query1 była modyfikowalna, musimy użyć tutaj VBA. Oto funkcja ChangeQuery która zmienia naszą kwerendę:
Function ChangeQuery(sQryName As String, sSQL As String) As Boolean

Dim db As Database

Dim qry As QueryDef

ChangeQuery = True

'odłóż obsługę błędów = w razie błędu idź dalej, do następnego wiersza kodu

On Error Resume Next

'czy istnieje kwerenda o podanej nazwie?

Set qry = CurrentDb.QueryDefs(sQryName)

If Not qry Is Nothing Then CurrentDb.QueryDefs.Delete sQryName

'odśwież kolekcję

CurrentDb.QueryDefs.Refresh

'przejmij obsługę błędów

On Error GoTo Err_ChangeQuery

'przejmij obsługę błędów

On Error GoTo Err_ChangeQuery

'dodaj nową kwerendę

'jeżeli nazwa kwerendy jest różna od „” automatycznie zostaje ona dodana do kolekcji QueryDefs

Set qry = CurrentDb.CreateQueryDef(sQryName, sSQL)

'odśwież kolekcję kwerend

CurrentDb.QueryDefs.Refresh

Exit_ChangeQuery:

'odłóż obsługę błędów

On Error Resume Next

qry.Close

Set qry = Nothing

db.Close

Set db = Nothing

Exit Function

'podprogram obsługi błędów

Err_ChangeQuery:

'wyczyść błąd

Err.Clear

'przejdź do podprogramu kończącego działanie funkcji

ChangeQuery = False

Resume Exit_ChangeQuery

End Function

——————

Sposób wykorzystania

Dim s1 As String, s2 As String, retVal As Long

warunek = ” modele.wiek < 30″

s1 = „query1”   ’NAZWA KWERENDY

warunek = warunek + „;”

s2 = „SELECT *” & vbCr & _

„FROM modele” & warunek                ’ZAPYTANIE SQL

’  DoCmd.SetWarnings False  'wylaczenie komunikatow sql

retVal = ChangeQuery(s1, s2)

MsgBox „Kwerenda ” & IIf(retVal, „została”, „NIE została”) & ” utworzona!”, vbInformation, „Komunikat”

DoCmd.Requery