[Tasos]

Καλησπέρα Γιαννη!


Θα σου πρότεινα να κάνεις τα εξής:

• Δημιούργησε έναν πίνακα με το όνομα: tblFormNames καιπρόσθεσε του ένα
  και μοναδικό πεδίο τύπου "κείμενο" με κάποιο όνομα της αρεσκείας σου.

• Στο πεδίο αυτό πληκτρολόγησε τα ονόματα των πεδίων του ερωτήματος πχ. "Το πεδίο μου", "Το άλλο μου πεδίο" κτλ.
• Πέρασε τον παρακάτω κώδικα σε μια κοινή λειτουργική μονάδα (Module) και τρέξε τον μια φορά.
  Θα σου δημιουργήσει ένα ερώτημα με τα πεδία του πίνακα σου που
  αρχίζουν από a και των οποίων τα ονόματα πηγάζουν από τον πίνακα tblFormName

Function Create_Query(TableName As String, QueryName As String, SearchLetters As String)
    WizHook.Key = 51488399
    Dim MyFields, strSQL As String, i As Integer, DynQry As QueryDef, x As String, FormField As DAO.Field
    MyFields = WizHook.GetColumns(TableName)
    TableName = "[" & TableName & "]"
    MyFields = Split(MyFields, ";")
    With CurrentDb.OpenRecordset("tblFormNames")
        .MoveFirst
        Set FormField = .Fields(0)
        For i = 0 To UBound(MyFields) - 1
            If MyFields(i) Like SearchLetters Then
                strSQL = strSQL & TableName & ".[" & MyFields(i) & "] As [" & FormField & "], "
                .MoveNext
                If .EOF Then Exit For
            End If
        Next
        .Close
    End With
    If InStr(1, strSQL, "]") Then
        strSQL = Left(strSQL, Len(strSQL) - 2)
        strSQL = "SELECT " & strSQL & " FROM " & TableName
        On Error Resume Next
        x = CurrentDb.QueryDefs(QueryName).Name
        If Err <> 0 Then Err.Clear
        If x <> vbNullString Then DoCmd.DeleteObject acQuery, QueryName
        If Err =  2008 Then
            Err.Clear
            DoCmd.Close acQuery, QueryName, acSaveNo
            DoCmd.DeleteObject acQuery, QueryName
        End If
        On Error GoTo ErrH
        Set DynQry = CurrentDb.CreateQueryDef(QueryName, strSQL)
        'DoCmd.OpenQuery QueryName
    Else
ErrH:
        MsgBox "Can not create the Query!" & IIf(Err <> 0, vbLf & "Error number: " & Err & _
               vbLf & "Error Description : " & Err.Description, vbNullString), vbExclamation
    End If

End Function

Sub test()
    Create_Query "Table1", "Query1", "a*" 
End Sub

• Σύνδεσε τα πεδία της φόρμας σου εκ νέου με τα πεδία του νέου αυτού ερωτήματος.
• Στη φόρμα σου δημιούργησε ένα κουμπί με το όνομα cmdRefresh και αντιστοίχησε του το παρακάτω:

Private Sub cmdRefresh_Click()
    Dim formName As String
    formName = Me.Name
    DoCmd.Close
    Create_Query "Table1", "Query1", "a*"
    DoCmd.OpenForm formName
End Sub

Δοκίμασε και τα λέμε πάλι.

Τάσος