TopPicLogo TopPicText

Вывод в Immadiate Window списка полей таблицы


Выводит в Immadiate Window (Ctrl + G) список полей указанной в аргументе таблицы, что очень полезно при написании процедур обработки записей
Если второй аргумент поставить = True (-1) - напечатает заготовку для работы DAO.RecordSet

Использование:
Просто напечатайте в Immadiate Window esTableFieldsPrint "ИМЯ_ТАБЛИЦЫ"
или:
esTableFieldsPrint "ИМЯ_ТАБЛИЦЫ", True

Public Sub esTableFieldsPrint(sTableName As String, Optional bForRST As Boolean = False)
'es - 15.11.2012
' Выводит в Immadiate Window (Ctrl + G) список полей указанной в аргументе таблицы
' Если второй аргумент поставить = True (-1) напечатает заготовку для работы DAO.RecordSet
'--------------------------------------------------------------------
Dim dbs As DAO.Database
Dim objField As DAO.Field
Dim sTab As String
Dim s As String
'--------------------------------------------------------------------
On Error GoTo esTableFieldsPrint_Err
    Set dbs = CurrentDb
    If bForRST = False Then 'Просто вывод полей
        s = "Таблица: " & sTableName & " - содержит поля:" & vbCrLf
        s = s & "--------------------------------------------" & vbCrLf
        For Each objField In dbs.TableDefs(sTableName).Fields
            s = s & vbTab & objField.Name & vbCrLf
        Next
    Else  'Вывод полей в заготовку под RecordSet
        s = "-------------------------------------------" & vbCrLf
        s = s & "Dim rst as DAO.RecordSet" & vbCrLf
        s = s & "Dim sSQL as String" & vbCrLf
        s = s & vbTab & "sSQL = ""SELECT * FROM " & sTableName & " WHERE " & dbs.TableDefs(sTableName).Fields(0).Name & " = 0""" & vbCrLf
        s = s & vbTab & "Set rst = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset)" & vbCrLf
        s = s & vbTab & "'Set rst = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)  'Только просмотр" & vbCrLf
        s = s & vbTab & "With rst" & vbCrLf
        s = s & vbTab & vbTab & "'.AddNew '.Edit" & vbCrLf
        
        sTab = vbTab & vbTab & vbTab
        For Each objField In dbs.TableDefs(sTableName).Fields
            s = s & sTab & "'!" & objField.Name & " = ""n/d!""" & vbCrLf
        Next
        s = s & vbTab & vbTab & "'.Update" & vbCrLf
        s = s & vbTab & "End With" & vbCrLf
        s = s & vbTab & vbCrLf
        s = s & vbTab & "On Error Resume Next" & vbCrLf
        s = s & vbTab & "rst.Close" & vbCrLf
        s = s & vbTab & "Set rst = Nothing" & vbCrLf
    End If
    Debug.Print s

esTableFieldsPrint_Bye:
    On Error Resume Next
    dbs.Close
    Exit Sub

esTableFieldsPrint_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure esTableFieldsPrint", vbCritical, "Error!"
    Resume esTableFieldsPrint_Bye
End Sub

Назад ToTop
L.E. 04.08.2015
Рейтинг@Mail.ru