Public Function CreateCatalog()

 Dim wks As Workspace
    Dim db As Database
    Dim dbMe As Database
    Dim rs As Recordset
    Dim tdf As TableDef
    Dim qdf As QueryDef
    Dim myfield As Field
    
    Dim intResponse As Integer
    Dim strDBPath As String
    Dim strField As String
    Dim strSQL As String
    Dim strSQLTableName As String
    Dim strSQLColumnName As String
    Dim strDATA As String
    Dim intRecordNumber As Integer
    
        
    MsgBox "Subroutine to create a file of database objects"
    
    DoCmd.Hourglass True
        
    strDBPath = "\\Server\path\AccessDB.mdb"
        
    strField = Chr(13)
    
    Set wks = DBEngine.CreateWorkspace("temp", "sysadmin", "")
    Set db = wks.OpenDatabase(strDBPath)
    Set dbMe = CurrentDb
    
    db.TableDefs.Refresh
    
    strDATA = "TableName,ColumnName,ColumnType,Size,ColOrder,Required,AllowZeroLength"
    intRecordNumber = 1
    Print #1, strDATA  ' Write record to file.
    intRecordNumber = 1
    
    'Loop trhough all the TableDefs in the database
    For Each tdf In db.TableDefs
        'Ignores system tables, which begin with "MSys" prefix
        If InStr(tdf.Name, "MSys") = 0 Then
            
            strDATA = tdf.Name
     
                'Loop through all the fields in the TableDef and add them to the message and SQL strings
                For Each myfield In tdf.Fields
                    strDATA = tdf.Name _
                    & "," & myfield.Name & "," & myfield.Type & "," & myfield.Size & "," & _
                    myfield.OrdinalPosition & "," & myfield.Required & "," & myfield.AllowZeroLength
                    
                        intRecordNumber = intRecordNumber + 1
                        'Print #1, intRecordNumber, strDATA  ' Write record to file.
                        Print #1, strDATA  ' Write record to file.
                        
                    'MsgBox strDATA
                Next
        End If
 Next
 Close #1    ' Close file.
 DoCmd.Hourglass False
 MsgBox "DONE!"
End Function