
TableInfo() function

This function displays in the Immediate Window (Ctrl+G) the structure of any table in the current database.
For Access 2000 or 2002, make sure you have a DAO reference.
The Description property does not exist for fields that have no description, so a separate function handles that error.
The code

Function TableInfo(strTableName As String)
On Error GoTo TableInfoErr
   ' Purpose:   Display the field names, types, sizes and descriptions for a table.
   ' Argument:  Name of a table in the current database.
   Dim db As DAO.Database
   Dim tdf As DAO.TableDef
   Dim fld As DAO.Field
   
   Set db = CurrentDb()
   Set tdf = db.TableDefs(strTableName)
   Debug.Print "FIELD NAME", "FIELD TYPE", "SIZE", "DESCRIPTION"
   Debug.Print "==========", "==========", "====", "==========="

   For Each fld In tdf.Fields
      Debug.Print fld.Name,
      Debug.Print FieldTypeName(fld),
      Debug.Print fld.Size,
      Debug.Print GetDescrip(fld)
   Next
   Debug.Print "==========", "==========", "====", "==========="

TableInfoExit:
   Set db = Nothing
   Exit Function

TableInfoErr:
   Select Case Err
   Case 3265&  'Table name invalid
      MsgBox strTableName & " table doesn't exist"
   Case Else
      Debug.Print "TableInfo() Error " & Err & ": " & Error
   End Select
   Resume TableInfoExit
End Function


Function GetDescrip(obj As Object) As String
    On Error Resume Next
    GetDescrip = obj.Properties("Description")
End Function


Function FieldTypeName(fld As DAO.Field) As String
    'Purpose: Converts the numeric results of DAO Field.Type to text.
    Dim strReturn As String    'Name to return

    Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long.
        Case dbBoolean: strReturn = "Yes/No"            ' 1
        Case dbByte: strReturn = "Byte"                 ' 2
        Case dbInteger: strReturn = "Integer"           ' 3
        Case dbLong                                     ' 4
            If (fld.Attributes And dbAutoIncrField) = 0& Then
                strReturn = "Long Integer"
            Else
                strReturn = "AutoNumber"
            End If
        Case dbCurrency: strReturn = "Currency"         ' 5
        Case dbSingle: strReturn = "Single"             ' 6
        Case dbDouble: strReturn = "Double"             ' 7
        Case dbDate: strReturn = "Date/Time"            ' 8
        Case dbBinary: strReturn = "Binary"             ' 9 (no interface)
        Case dbText                                     '10
            If (fld.Attributes And dbFixedField) = 0& Then
                strReturn = "Text"
            Else
                strReturn = "Text (fixed width)"        '(no interface)
            End If
        Case dbLongBinary: strReturn = "OLE Object"     '11
        Case dbMemo                                     '12
            If (fld.Attributes And dbHyperlinkField) = 0& Then
                strReturn = "Memo"
            Else
                strReturn = "Hyperlink"
            End If
        Case dbGUID: strReturn = "GUID"                 '15

        'Attached tables only: cannot create these in JET.
        Case dbBigInt: strReturn = "Big Integer"        '16
        Case dbVarBinary: strReturn = "VarBinary"       '17
        Case dbChar: strReturn = "Char"                 '18
        Case dbNumeric: strReturn = "Numeric"           '19
        Case dbDecimal: strReturn = "Decimal"           '20
        Case dbFloat: strReturn = "Float"               '21
        Case dbTime: strReturn = "Time"                 '22
        Case dbTimeStamp: strReturn = "Time Stamp"      '23

        'Constants for complex types don't work prior to Access 2007 and later.
        Case 101&: strReturn = "Attachment"         'dbAttachment
        Case 102&: strReturn = "Complex Byte"       'dbComplexByte
        Case 103&: strReturn = "Complex Integer"    'dbComplexInteger
        Case 104&: strReturn = "Complex Long"       'dbComplexLong
        Case 105&: strReturn = "Complex Single"     'dbComplexSingle
        Case 106&: strReturn = "Complex Double"     'dbComplexDouble
        Case 107&: strReturn = "Complex GUID"       'dbComplexGUID
        Case 108&: strReturn = "Complex Decimal"    'dbComplexDecimal
        Case 109&: strReturn = "Complex Text"       'dbComplexText
        Case Else: strReturn = "Field type " & fld.Type & " unknown"
    End Select

    FieldTypeName = strReturn
End Function






   ***** Code Start *****
Public Sub CompactDB()

   CommandBars("Menu Bar"). _
   Controls("Tools"). _
   Controls("Database utilities"). _
   Controls("Compact and repair database..."). _
   accDoDefaultAction

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


'*********************************************************
Public Function CompactRepair(cadena As String) As String

Dim sDBPATH As String, sDBNAME As String, sDB As String, sDBtmp As String
sDBNAME = sDBFILE 'extrapulate the file name

Do While InStr(1, sDBNAME, "\") <> 0
        sDBNAME = Right(sDBNAME, Len(sDBNAME) - InStr(1, sDBNAME, "\"))
Loop

'get the path name only
sDBPATH = Left(sDBFILE, Len(sDBFILE) - Len(sDBNAME))
sDB = sDBPATH & sDBNAME
sDBtmp = sDBPATH & "tmp_" & sDBNAME
'Call the statement to execute compact and repair...
If sPASSWORD <> "" Then
        Call DBEngine.CompactDatabase(sDB, sDBtmp, dbLangGeneral, , ";pwd=" & sPASSWORD)
Else
        Call DBEngine.CompactDatabase(sDB, sDBtmp)
End If
'wait for the app to finish
        DoEvents
'remove the uncompressed original
        Kill sDB
'rename the compressed file to the original to restore for other functions
        Name sDBtmp As sDB
End Sub 




'****************************************************************************
'compactar y repara un mdb mediante codigo
Public Sub CompactDatabase()
      'Run this code before closing the Database.
      Dim vStatusBar As Variant
      On Error GoTo Err_CompactOnClose
      
          If FileLen(CurrentDb.Name) > 2000000 Then
              Application.SetOption ("Auto Compact"), 1
              Application.SetOption "Show Status Bar", True
              vStatusBar = SysCmd(acSysCmdSetStatus, "The application must be compacted, please do not interfere with the Compacting process!")
          Else
              Application.SetOption ("Auto Compact"), 0
          End If
      
Exit_CompactOnClose:
          Exit Sub
      
Err_CompactOnClose:
          MsgBox Err.Number & " - " & Err.Description
          Resume Exit_CompactOnClose

End Sub




'---------------------------------------------------------------------------------------
' Procedure : GetFileSize
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine the size of a specified files (in Bytes)
' Copyright : The following may be altered and reused as you wish so long as
the
'             copyright notice is left unchanged (including Author, Website
and
'             Copyright).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile   Path & Full Filename of the file to retrieve the file info about
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' GetFileSize("C:\Temp\Dataset.xls")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
'
**************************************************************************************
' 1         2008-Oct-09                 Initial Release
'---------------------------------------------------------------------------------------
Function GetFileSize(strFile As String)
Dim oFSO As Object
Dim oF As Object

On Error GoTo Error_Handler

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oF = oFSO.GetFile(strFile)

GetFileSize = oF.Size

Set oF = Nothing
Set oFSO = Nothing

Exit Function

Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf &
Err.Number & vbCrLf & "Error Source: GetFileSize" & vbCrLf & "Error
Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Exit Function
End Function

and use it like:
GetFileSize(application.CurrentDb.Name)



