[nisgia]

Καλησπέρα Γιώργο και σ' ευχαριστώ για τα καλά σου λόγια!

Με τις χρήσιμες (όπως πάντα) παρατηρήσεις σου, το "τραγούδι", μου βγήκε λίγο ...HEAVY METAL
όμως ο "στοίχος" του, νομίζω πως έγινε πολύ πιο στιβαρός από τον πρωινό.

Ελπίζω να το απολαύσεις...

Function GetFlexQueryEx(TableName As String, _
        Optional QueryName As String, _
        Optional Pattern As String = "*") As Recordset

    Dim strSQL As String
    Dim fld As Field
    Dim flds As Fields
    Dim rs As Recordset

    On Error Resume Next
    Set flds = CurrentDb.TableDefs(TableName).OpenRecordset.Fields

    If flds Is Nothing Then
        MsgBox "TableDef """ & TableName & """ not found!", vbExclamation
    Else
        If Pattern = "*" Then
            strSQL = Pattern
        Else
            For Each fld In flds
                If fld.Name Like Pattern Then
                    strSQL = strSQL & ", [" & fld.Name & "]"
                End If
            Next fld
            strSQL = Mid(strSQL, 2)
        End If

        strSQL = "SELECT " & strSQL & " FROM [" & TableName & "]"
        Debug.Print strSQL
        Set rs = CurrentDb.OpenRecordset(strSQL)

        If Len(QueryName) Then
            DoCmd.Close acQuery, QueryName, acSaveNo
            Err.Clear
            DoCmd.DeleteObject acQuery, QueryName
            If Err = 0 Then
                Debug.Print "QueryDef """ & QueryName & """ deleted!"
            Else
                Err.Clear
            End If
            If rs Is Nothing Then
                MsgBox "No fields found in " & TableName _
                        & " with name like """ & Pattern & """" & vbCrLf _
                        & "Could not create query """ & QueryName & """!", vbExclamation
            Else
                CurrentDb.CreateQueryDef QueryName, strSQL
                If Err = 0 Then
                    Debug.Print "QueryDef """ & QueryName & """ created!"
                Else
                    MsgBox Err.Description, vbExclamation
                    Err.Clear
                End If
                Application.RefreshDatabaseWindow
            End If
        End If
        Set GetFlexQueryEx = rs
    End If
End Function

Sub TestFlexQueryEx()
    GetFlexQueryEx "Table1", "qryAllFields"        'Dimiourgia erwtimatos me ola ta pedia
    'GetFlexQueryEx "Table1", "qryAllFields", " "   'Mono diagrafi tou erwtimatos apo ti basi(an yparxei)
    'GetFlexQueryEx "Table1", "Query1", "a*"        'Dimiourgia erwtimatos me epilegmena pedia
    
    'Xrisi tou synolou egrafwn xwris dimiourgia erwtimatos
    On Error Resume Next
    Debug.Print GetFlexQueryEx("Table1").Fields.Count
End Sub

Το μόνο ζήτημα που μένει λίγο ασαφές, είναι το αν θα πρέπει να διαγράφεται το υπάρχον ερώτημα
όταν δεν υπάρχει πεδίο με όνομα που να ταιριάζει στο υπόδειγμα (Pattern).
Νομίζω όμως πως δεν είναι και τόσο σημαντικό μιας και πρόκειται για διαγραφή ερωτήματος
και όχι πραγματικών δεδομένων.

Φιλικά,
Γιάννης