'테이블명, 필드명, 필드설명등을 가져온다

Option Base 1
Public Sub Enumerate_Table()
On Error GoTo ERROR_PROC
Dim aryFields()
Dim lngCount As Long
lngCount = 0
strInput = InputBox( "Please enter the name of the table for which" & vbCrLf & _
                              "you wish to list FieldNames & Descriptions." & vbCrLf & vbCrLf & _
                              "Output will be placed in tab-delimited text file.", "Table Name Input", "MainTabl")
If StrPtr(strInput) = 0 Or Len(strInput) = 0 Then
     Exit Sub
Else
     strSQL = "SELECT * FROM " & strInput
     Dim Adofl As ADODB.Field
     Dim rs As New ADODB.Recordset
     rs.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
     For Each Adofl In rs.Fields
         lngCount = lngCount + 1
         ReDim Preserve aryFields(2, lngCount)
         aryFields(1, lngCount) = Adofl.Name
         aryFields(2, lngCount) = GetFieldDesc_ADO(strInput, Adofl.Name)
     Next
     rs.Close 'recordset closed for next item.
End If
 ' ***************************** Feed array to designated file ***********************
If lngCount > 0 Then
     aFileNum = FreeFile
     Open "C:\Temp\TableStruc.txt" For Output As #aFileNum
     For i = 1 To UBound(aryFields(), 2)
         Print #aFileNum, aryFields(1, i) & vbTab & aryFields(2, i)
     Next
     Close #aFileNum
Final_Results:
     Btn = MsgBox( "Table fieldnames with Descriptions stored in:" & vbCrLf & vbCrLf & _
                             "C:\Temp\TableStruc.txt" & vbCrLf & vbCrLf & _
                             "Do you wish to OPEN using NOTEPAD?", vbOKCancel + vbQuestion, _
                             " Table Enumeration")
     If Btn = vbOK Then
          ' ************ Opening the file in Notepad *******
         Shell "Notepad.exe" & " " & "C:\Temp\TableStruc.txt", vbMaximizedFocus
     End If
Else
     MsgBox "Table Not Found!", vbOKOnly + vbExclamation, _
                     "Bad Table Name"
End If
Exit Sub
ERROR_PROC:
rs.Close
MsgBox "Error encountered attempting to enumerate table!"
End Sub

 ' *********************************************************************************************
 ' This function requires a reference to ADO 2.5 Ext. for DDL & Security (or higher)
 ' *********************************************************************************************
Function GetFieldDesc_ADO(ByVal MyTableName As String, ByVal MyFieldName As String)
    Dim MyDB As New ADOX.Catalog
    Dim MyTable As ADOX.Table
    Dim MyField As ADOX.Column
    On Error GoTo Err_GetFieldDescription
    MyDB.ActiveConnection = CurrentProject.Connection
    Set MyTable = MyDB.Tables(MyTableName)
    GetFieldDesc_ADO = MyTable.Columns(MyFieldName).Properties( "Description")
    Set MyDB = Nothing
Bye_GetFieldDescription:
    Exit Function
Err_GetFieldDescription:
    Beep
    MsgBox Err.Description, vbExclamation
    GetFieldDescription = Null
    Resume Bye_GetFieldDescription
End Function

Copyright By AccessVision