Accessのカラム一覧を出力

Accessのカラム一覧をテキストに出力する。

Option Compare Database

Private Const OUT_FILE  As String = "D:\tabcoloum.tsv"
'
'   テーブルのカラム一覧を出力します
'
Public Sub get_TableColumns()
   
    Dim MyDB As DAO.Database
    Dim wkTableDef As DAO.TableDef
    Dim wkFld As DAO.Field
    Dim strTablename As String
    Dim wkTableDef2 As DAO.TableDef
    Dim buf As String
    
    'ヘッダを出力
    Call putText_Propatey_header
    
    fileNo = FreeFile
    Open OUT_FILE For Append As #fileNo
    
    Set MyDB = CurrentDb
    
    '全てのテーブルを検索
    For Each wkTableDef In MyDB.TableDefs
        
      strTablename = wkTableDef.Name
     
      'システムオブジェクトは対象外
      If Left(strTablename, 2) <> "MS" Then
     
          Set wkTableDef2 = MyDB.TableDefs(strTablename)
          
          'すべてのカラムを検索
          For Each wkFld In wkTableDef2.Fields
            
            buf = strTablename
            buf = buf & vbTab & wkFld.Name
            buf = buf & vbTab & wkFld.Type
            buf = buf & vbTab & wkFld.Size
            buf = buf & vbTab & wkFld.AllowZeroLength
            
            Print #fileNo, buf
            
          Next wkFld
        
       End If
    
    Next wkTableDef
    
    Close #fileNo
    
    MyDB.Close
    Set MyDB = Nothing
    
    MsgBox "出力が完了しました。"
    
End Sub

Private Function putText_Propatey_header()
  Dim fileNo As Integer
  Dim buf As String
  Dim i As Long

On Error Resume Next
    
    fileNo = FreeFile
    Open OUT_FILE For Append As #fileNo
    
    buf = buf & "TableName" & vbTab
    buf = buf & "Name" & vbTab
    buf = buf & "Type" & vbTab
    buf = buf & "Size" & vbTab
    buf = buf & "AllowZeroLength" & vbTab
        
    Print #fileNo, buf
    
    Close #fileNo

End Function

動作確認環境:Access2003