' Accessデータベースのフィールド情報の取得
 Sub Macro1()
     Dim DbName As String, DbPath As String, ConnStr As String
     Dim FSO As Object, TypeCst As Object, TypeSql As Object
     Dim CN As ADODB.Connection, CAT As ADOX.Catalog
     Dim Tbl As Variant, FldName As Variant, Col As Object
     Dim TypeStr As String, IdxHash As Object, Ary As Object, i As Integer
 
     Set FSO = CreateObject("Scripting.FileSystemObject")
    DbName = InputBox("Accessファイルの名前：　", _
        "Accessフィールド情報取得", "TestDB.mdb")
    If DbName = "" Then Exit Sub
    CreateObject("WScript.Shell").CurrentDirectory = ThisWorkbook.Path
    DbPath = FSO.GetAbsolutePathName(DbName)
    If FSO.FileExists(DbPath) = False Then
        MsgBox "ファイルがみつかりません: " & DbPath
        Exit Sub
    End If

    ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DbPath & ";"
    Set CN = New ADODB.Connection
    CN.Open ConnStr
    Set CAT = New ADOX.Catalog
    CAT.ActiveConnection = CN
    Set TypeCst = TypeCstHash()  ' データ型：番号と定数名の関連付け
    Set TypeSql = TypeSqlHash()  ' データ型：番号とSQL表記の関連付け

    Set Ary = CreateObject("System.Collections.ArrayList")
    For Each Tbl In CAT.Tables  ' テーブルを一つずつたどる
        If (Tbl.Type = "TABLE") Or (Tbl.Type = "VIEW") Then
            FldName = GetFieldName(CN, Tbl.Name)  ' フィールド名一覧を取得
            Ary.Add Array(Tbl.Name, Tbl.Type)
            Set IdxHash = IndexHash(Tbl)
            For i = 0 To UBound(FldName)  ' フィールドを一つずつ
                Set Col = Tbl.Columns(FldName(i))
                TypeStr = FieldSqlStr(Col, TypeSql)
                If IdxHash.Exists(Col.Name) Then
                    TypeStr = TypeStr & " " & IdxHash(Col.Name)
                End If
                Ary.Add Array("", Col.Name, TypeCst(Col.Type), TypeStr)
            Next
            Ary.Add Array("")
        End If
    Next
    CN.Close

    ActiveSheet.UsedRange.Clear
    For i = 0 To (Ary.Count-1)
        Range(Cells(i+1, 1), Cells(i+1, UBound(Ary(i))+1)).Value = Ary(i)
    Next
    For i = 1 To ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.UsedRange.Columns(i).AutoFit
    Next
End Sub

    （以下、関数部分は省略）

 Function GetFieldName(CN, ByVal TblName)  ' フィールド名の取得
     Dim RS As ADODB.Recordset, FldName() As Variant
     Dim FldCount As Integer, i As Integer
     TblName = "[" & TblName & "]"
     Set RS = New ADODB.Recordset
     RS.Open TblName,CN,0,1,2
     FldCount = RS.Fields.Count
     ReDim FldName(FldCount-1)
     For i = 0 To (FldCount-1)
        FldName(i) = RS.Fields(i).Name
    Next
    RS.Close
    Set RS = Nothing
    GetFieldName = FldName
End Function

 Function FieldSqlStr(Col, TypeSql)  ' フィールド情報をSQL表記に
     Dim TypeStr As String, Val As Variant
     If Col.Properties("Autoincrement").Value = True Then
         TypeStr = "counter(" & Col.Properties("Seed").Value & _
             "," & Col.Properties("Increment").Value & ")"
     Else
         TypeStr = TypeSql(Col.Type)
     End If
     If (Col.DefinedSize > 0) And (Col.Type <> adBoolean) Then _
        TypeStr = TypeStr & "(" & Col.DefinedSize & ")"
    If Col.Type = adNumeric Then _
        TypeStr = TypeStr & "(" & Col.Precision & ", " & _
            Col.NumericScale & ")"
    Val = Col.Properties("Default").Value
    If Val <> "" Then
        If InStr(Val, " ") Then Val = "[" & Val & "]"
        TypeStr = TypeStr & " DEFAULT " & val
    End If
    Val = Col.Properties("NULLable").Value
    If Val = False Then
        TypeStr = TypeStr & " NOT NULL"
    End If
    FieldSqlStr = TypeStr
End Function

Function TypeSqlHash()
    Dim TypeSql As Object
    Set TypeSql = CreateObject("Scripting.Dictionary")
    TypeSql.Add 2, "SmallInt"
    （中略）
    Set TypeSqlHash = TypeSql
End Function

 ' Accessデータベースのフィールド情報を取得
 Option Explicit
 Dim FSO, Fobj, DbName, DbPath, TypeCst, TypeSql
 Dim ConnStr, CN, CAT, Tbl, FldName, Col, Ary, TypeStr, IdxHash, i
 Include "constants_ad.vbs"
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 DbName = InputBox("Accessファイルの名前：　", _
     "Accessフィールド情報取得", "TestDB.mdb")
If DbName = "" Then WScript.Quit
DbPath = FSO.GetAbsolutePathName(DbName)
If FSO.FileExists(DbPath) = False Then
    MsgBox "ファイルがみつかりません: " & DbPath
    WScript.Quit
End If

ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DbPath & ";"
Set CN = CreateObject("ADODB.Connection")
CN.Open ConnStr
Set CAT = CreateObject("ADOX.Catalog")
CAT.ActiveConnection = CN
Set TypeCst = TypeCstHash()  ' データ型：番号と定数名の関連付け
Set TypeSql = TypeSqlHash()  ' データ型：番号とSQL表記の関連付け

Set Ary = CreateObject("System.Collections.ArrayList")
For Each Tbl In CAT.Tables  ' テーブルを一つずつたどる
    If (Tbl.Type = "TABLE") Or (Tbl.Type = "VIEW") Then
        FldName = GetFieldName(CN, Tbl.Name)  ' フィールド名一覧を取得
        Ary.Add Array("＊" & Tbl.Name, Tbl.Type)
        Set IdxHash = IndexHash(Tbl)
        For i = 0 To UBound(FldName)  ' フィールドを一つずつ
            Set Col = Tbl.Columns(FldName(i))
            TypeStr = FieldSqlStr(Col, TypeSql)
            If IdxHash.Exists(Col.Name) Then
                TypeStr = TypeStr & " " & IdxHash(Col.Name)
            End If
            Ary.Add Array("", Col.Name, TypeCst(Col.Type), TypeStr)
        Next
        Ary.Add Array("")
    End If
Next
CN.Close
Set Fobj = FSO.OpenTextFile("FieldInfo.txt", 2, True)
For i = 0 To (Ary.Count-1)
    Fobj.WriteLine Join(Ary(i), vbTab)
Next
Fobj.Close

    （以下、後略）

 // Accessデータベースのフィールド情報の取得
 var fso, Fobj, dbName, dbPath, typeCst, typeSql;
 var connStr, cn, cat, tbl, fldName, idxHash, col, Ary, i, j;
 eval(ReadFile("constants_ad.js"));
 
 fso = WScript.CreateObject("Scripting.FileSystemObject");
 dbName = InputBox("Accessファイルの名前：　",
     "Accessフィールド情報取得", "TestDB.mdb");
 if (dbName == "")  WScript.Quit();
dbPath = fso.GetAbsolutePathName(dbName);
if (fso.FileExists(dbPath) == false) {
    var shellObj = WScript.CreateObject("WScript.Shell");
    WScript.Echo("ファイルがみつかりません: " + dbPath);
    while (shellObj.AppActivate("Windows Script Host") != true) {
        WScript.Sleep(100);
    }
    WScript.Quit();
}

connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + dbPath + ";";
cn = WScript.CreateObject("ADODB.Connection");
cn.Open(connStr);
cat = WScript.CreateObject("ADOX.Catalog");
cat.ActiveConnection = cn;
typeCst = TypeCstHash();  // データ型：番号と定数名の関連付け
typeSql = TypeSqlHash();  // データ型：番号とSQL表記の関連付け

Ary = [];
for (i=0; i<cat.Tables.Count; i++) {  // テーブルを一つずつたどる
    tbl = cat.Tables(i);
    if (tbl.Type == "TABLE" || tbl.Type == "VIEW") {
        Ary.push(["＊" + tbl.Name, tbl.Type]);
        fldName = GetFieldName(cn, tbl.Name);  // フィールド名一覧を取得
        idxHash = IndexHash(tbl);
        for (j=0; j<fldName.length; j++) {  // フィールドを一つずつ
            col = tbl.Columns(fldName[j]);
            typeStr = FieldSqlStr(col, typeSql);
            if (idxHash[col.Name] != null)
                typeStr = typeStr + " " + idxHash[col.Name];
            Ary.push(["", col.Name, typeCst[col.Type], typeStr]);
        }
        Ary.push([""]);
    }
}
cn.Close();
Fobj = fso.OpenTextFile("FieldInfo.txt", 2, true);
for (i = 0; i < Ary.length; i++) {
    Fobj.WriteLine(Ary[i].join("\t"));
}
Fobj.Close();

    （以下、省略）

 Function IndexHash(Tbl)  ' インデックス情報の取得
     Dim IdxHash As Object, Idx As Variant, Str As String, Col As Variant
     Set IdxHash = CreateObject("Scripting.Dictionary")
     For Each Idx In Tbl.Indexes
         Str = ""
         If Idx.PrimaryKey Then Str = "primary key"
         If (Str = "") And Idx.Unique Then Str = "unique"
         If Str <> "" Then
             For Each Col In Idx.Columns
                If IdxHash.Exists(Col.Name) = False Then _
                    IdxHash.Add Col.Name, Str
            Next
        End If
    Next
    Set IndexHash = IdxHash
End Function