Campos de documento para la tabla de Access en la ventana de depuración

VBA

Módulo estándar

Especifique el nombre de SU tabla o consulta en
¡PERSONALIZAR!
y posiblemente también cambie bIsTable, iTab, bFieldnameOnly y bShowMessage. iTab es la cantidad de caracteres para el nombre del campo. Los míos son cortos, pero si los tuyos son más largos, hazlos más grandes. El código podría repetirse y resolverlo, pero decidí mantenerlo simple. La cantidad máxima de caracteres para un nombre de campo es 64 (demasiado largo, en mi opinión).

Mi Obtener propiedad La función está comentada porque tengo un módulo que puedes descargar para administrar las propiedades, pero si no lo tienes, descomentá, depurá, compilá y guardá. Aquí está la página de referencia si quieres el módulo completo:

Módulo para gestionar propiedades de objetos con VBA

'module: mod_Document_Fields2Debug_s4p
'*************** Code Start ***********************************************
' Purpose  : Document fieldnames and other information
'              to the Debug window
'              for a particular table or query
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'-------------------------------------------------------------------------------
'           Document_Fields2Debug_s4p
'-------------------------------------------------------------------------------
Public Sub Document_Fields2Debug_s4p() 
'230601 s4p, 608, 609 AutoNumber
'list fields to Debug window for a specified Table or a Query

   'CLICK HERE
   '  PRESS F5 to Run!
   '
   'PRESS Ctrl-G to go to Debug window
   'drag by titlebar to float if you want to change its size
   
   'CALLS
   '  Get_Property
   
   On Error GoTo Proc_Err 
   
   Dim sTable As String _ 
      ,sTitle As String _ 
      ,iTab As Integer _ 
      ,bIsTable As Boolean _ 
      ,bFieldnameOnly As Boolean _ 
      ,bShowMessage As Boolean 
      
   '----------------------------- CUSTOMIZE!
   sTable =  "c_Contact" 'YOUR TABLE or query name
   bIsTable = True  'false to document a query
   iTab = 20  'make bigger if you have long fieldnames
   bFieldnameOnly = False  'True to list fieldnames only
   bShowMessage = True  'show MsgBox at end
   '-----------------------------
   
   Dim db As DAO.Database _ 
      ,oTable As Object _ 
      ,oField As DAO.Field 

   Set db = CurrentDb 
   
   sTitle = String(5, "=") 
   
   If bIsTable = True Then 
      Set oTable = db.TableDefs(sTable) 
      sTitle = sTitle &  " Table " & sTitle 
   Else 
      Set oTable = db.QueryDefs(sTable) 
      sTitle = sTitle &  " Query " & sTitle 
   End If 
   sTitle = sTitle &  " " & sTable &  " " & String(10, "=") 
   
   With oTable 
      Debug.Print sTitle 
      Debug.Print  "-Fieldname-"; 
      If bFieldnameOnly Then 
         Debug.Print 
      Else 
         Debug.Print Tab(iTab);  "-Type-"; 
         Debug.Print Tab(iTab + 7);  "-Size-"; 
         Debug.Print Tab(iTab + 14);  "-Description-"
      End If 
      
      For Each oField In .Fields 
         With oField 
            Debug.Print .Name; 
            If bFieldnameOnly Then 
               Debug.Print 
            Else 
               If .Type = 4 And _ 
                     (.Attributes And dbAutoIncrField) _ 
                     = dbAutoIncrField Then 
                  Debug.Print Tab(iTab);  "(AutoNumber)"; 
'                  Debug.Print " (AutoNumber)";
               Else 
                  Debug.Print Tab(iTab); .Type; 
                  Debug.Print Tab(iTab + 7); .Size; 
               End If 
               
               Debug.Print Tab(iTab + 14); _ 
                  Get_Property( "Description",oField, "") 
            End If 
         End With 
      Next oField 
   End With  'tdf

   If bShowMessage Then 
      MsgBox  "Press Ctrl_G to see field information for " _ 
         & sTable &  " in the Debug window" _ 
         ,, "done"
   End If 
   
Proc_Exit: 
   On Error Resume Next 
   Set oField = Nothing 
   Set oTable = Nothing 
   Set db = Nothing 
   Exit Sub 
  
Proc_Err: 
   MsgBox Err.Description,,_ 
        "ERROR " & Err.Number _ 
        &  "   Document_Fields2Debug_s4p "

   Resume Proc_Exit 
   Resume 
End Sub 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           Get_Property
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' UNCOMMENT if you need this
' Get_Property is in mod_Properties_s4p
' posted here:
' 
'
'Function Get_Property( _
'   psPropName As String _
'   , Optional obj As Object _
'   , Optional pvDefaultValue As Variant _
'   ) As Variant
''s4p 8-9 ... 130831, 160820, 170721, 191124, 200511, 220403
'' get the value of a database (or object) property
'' pass (optional) object to look somewhere other than CurrentDb
'' pass (optional) default value to return if property not set
'
'   ' PARAMETERS
'   '  psPropName is the (database) property name to return the value of
'   ' OPTIONAL
'   '  obj = database, field, tabledef, querydef,
'   '   or other object with properties
'   '   if obj is not specified, then CurrentDb is used
'   '  pvDefaultValue is value to return if property cannot be read
'   '
'   'RETURNS
'   ' Value of property
'   ' OR
'   ' Null (or pvDefaultValue) if property has no value or is not defined
'
'   'EXAMPLES
'   '  MyValue = Get_Property("MyDatabasePropertyName")
'   '  MyFieldDescription = Get_Property("Description",oField,"")
'   ' ?Get_Property("Description",currentdb.TableDefs("MyTable").fields("MyField"))
'
'   On Error GoTo Proc_Err
'
'   Dim bRelease As Boolean
'   bRelease = False
'
'   If obj Is Nothing Then
'      Set obj = CurrentDb
'      bRelease = True
'   End If
'
'   'initialize return value
'   If Not IsMissing(pvDefaultValue) Then
'      Get_Property = pvDefaultValue
'   Else
'      Get_Property = Null
'   End If
'
'   With obj
'      Get_Property = obj.Properties(psPropName)
'   End With
'
'Proc_Exit:
'   On Error Resume Next
'   If bRelease Then Set obj = Nothing
'   Exit Function
'
'Proc_Err:
'   Resume Proc_Exit
'
'End Function

'*************** Code End *****************************************************