Program Page: データベースのField情報の取得

カテゴリー名：　［ADOによるデータベースの中身の把握］

関連の解説ページへ戻る

《このページの目次》

• 1.　VBAマクロ
• 2.　OLEを利用したVBScript
• 3.　JScript

1.　VBAマクロ

△　macro02.txt

' Accessデータベースのフィールド情報の取得
Option Explicit

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 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

' ----------------

' データベースのデータ型：番号と定数名の関連付け
Function TypeCstHash()
    Dim TypeCst As Object
    Set TypeCst = CreateObject("Scripting.Dictionary")
    TypeCst.Add 2, "adSmallInt"
    TypeCst.Add 3, "adInteger"
    TypeCst.Add 4, "adSingle"
    TypeCst.Add 5, "adDouble"
    TypeCst.Add 6, "adCurrency"
    TypeCst.Add 7, "adDate"
    TypeCst.Add 8, "adBSTR"
    TypeCst.Add 9, "adIDispatch"
    TypeCst.Add 10, "adError"
    TypeCst.Add 11, "adBoolean"
    TypeCst.Add 12, "adVariant"
    TypeCst.Add 13, "adIUnknown"
    TypeCst.Add 14, "adDecimal"
    TypeCst.Add 16, "adTinyInt"
    TypeCst.Add 17, "adUnsignedTinyInt"
    TypeCst.Add 18, "adUnsignedSmallInt"
    TypeCst.Add 19, "adUnsignedInt"
    TypeCst.Add 20, "adBigInt"
    TypeCst.Add 21, "adUnsignedBigInt"
    TypeCst.Add 64, "adFileTime"
    TypeCst.Add 72, "adGUID"
    TypeCst.Add 128, "adBinary"
    TypeCst.Add 129, "adChar"
    TypeCst.Add 130, "adWChar"
    TypeCst.Add 131, "adNumeric"
    TypeCst.Add 132, "adUserDefined"
    TypeCst.Add 133, "adDBDate"
    TypeCst.Add 134, "adDBTime"
    TypeCst.Add 135, "adDBTimeStamp"
    TypeCst.Add 136, "adChapter"
    TypeCst.Add 138, "adPropVariant"
    TypeCst.Add 139, "adVarNumeric"
    TypeCst.Add 200, "adVarChar"
    TypeCst.Add 201, "adLongVarChar"
    TypeCst.Add 202, "adVarWChar"
    TypeCst.Add 203, "adLongVarWChar"
    TypeCst.Add 204, "adVarBinary"
    TypeCst.Add 205, "adLongVarBinary"
    Set TypeCstHash = TypeCst
End Function

' データベースのデータ型：番号とSQL表記の関連付け
Function TypeSqlHash()
    Dim TypeSql As Object
    Set TypeSql = CreateObject("Scripting.Dictionary")
    TypeSql.Add 2, "SmallInt"
    TypeSql.Add 3, "int"
    TypeSql.Add 4, "real"
    TypeSql.Add 5, "float"
    TypeSql.Add 6, "money"
    TypeSql.Add 7, "date"
    TypeSql.Add 11, "YesNo"
    TypeSql.Add 17, "TinyInt" 
    TypeSql.Add 72, "guid"
    TypeSql.Add 130, "char"
    TypeSql.Add 131, "decimal"
    TypeSql.Add 202, "varchar"
    TypeSql.Add 203, "longtext"
    TypeSql.Add 204, "binary"
    TypeSql.Add 205, "longbinary"
    Set TypeSqlHash = TypeSql
End Function

目次に戻る

2.　OLEを利用したVBScript

△　vovTBL02.vbs

' 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

' ----------------

Function GetFieldName(CN, ByVal TblName)  ' フィールド名の取得
    Dim RS, FldName(), FldCount, i
    TblName = "[" & TblName & "]"
    Set RS = CreateObject("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, Val
    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 IndexHash(Tbl)  ' インデックス情報の取得
    Dim IdxHash, Idx, Str, Col
    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

' ----------------

Sub Include(ByVal FileName)
    Dim FSO, FileObj, MyStr
    Set FSO = CreateObject("Scripting.FileSystemObject") 
    Set FileObj = FSO.OpenTextFile(FSO.GetAbsolutePathName(FileName))
    MyStr = FileObj.ReadAll()
    FileObj.Close
    Set FSO = Nothing
    Set FileObj = Nothing
    ExecuteGlobal MyStr
End Sub

目次に戻る

3.　JScript

△　vovTBL02.js

// 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 GetFieldName(cn, tblName) {  // フィールド名の取得
    var rs, fldName, fldCount, i;
    tblName = "[" + tblName + "]";
    rs = WScript.CreateObject("ADODB.Recordset");
    rs.Open(tblName,cn,0,1,2);
    fldCount = rs.Fields.Count;
    fldName = Array(fldCount);
    for (i=0; i<fldCount; i++) {
        fldName[i] = rs.Fields(i).Name
    }
    rs.Close();
    return fldName
}

// ----------------

function FieldSqlStr(col, typeSql) {  // フィールド情報をSQL表記に
    var typeStr, val;
    if (col.Properties("Autoincrement").Value == true)
        typeStr = "counter(" + col.Properties("Seed").Value +
            "," + col.Properties("Increment").Value + ")";
    else
        typeStr = typeSql[col.Type];
    if (col.DefinedSize > 0 && col.Type != adBoolean)
        typeStr = typeStr + "(" + col.DefinedSize + ")";
    if (col.Type == adNumeric)
        typeStr = typeStr + "(" + col.Precision + ", " +
            col.NumericScale + ")";
    val = col.Properties("Default").Value;
    if (val != null) {
        if (val.indexOf(" ") >= 0) val = "[" + val + "]";
        typeStr = typeStr + " DEFAULT " + val;
    }
    val = col.Properties("NULLable").Value;
    if (val == false)
        typeStr = typeStr + " NOT NULL";
    return typeStr;
}

// ----------------

function IndexHash(tbl) {  // インデックス情報の取得
    var idxHash, idx, str, col, i, j;
    idxHash = {};
    for (i=0; i<tbl.Indexes.Count; i++) {
        idx = tbl.Indexes(i);
        str = "";
        if (idx.PrimaryKey)  str = "primary key";
        if (str == "" && idx.Unique)  str = "unique";
        if (str != "") {
            for (j=0; j<idx.Columns.Count; j++) {
                col = idx.Columns(j);
                if (idxHash[col.Name] == null)
                    idxHash[col.Name] = str;
            }
        }
    }
    return idxHash;
}

// ----------------

function InputBox(prmpt, ttl, dflt) {
    var sh = WScript.CreateObject("WScript.Shell");
    var tmpFile = sh.Environment("Process").item("TEMP") + "\\MyTest.vbs";
    var fso = WScript.CreateObject("Scripting.FileSystemObject");
    var cmdStr = "Set FSO = CreateObject(\"Scripting.FileSystemObject\")\n" +
        "dbName = InputBox(\"" + prmpt + "\", _\n" +
        "\"" + ttl + "\", \"" + dflt + "\")\n" +
        "FSO.GetStandardStream(1).Write dbName\n";
    var Fobj = fso.OpenTextFile(tmpFile, 2, true);
    Fobj.Write(cmdStr);
    Fobj.Close();
    execObj = sh.Exec("CScript.exe /Nologo " + tmpFile);
    while (execObj.Status == 0) {  // コマンド実行の終了を待つ
        WScript.Sleep(100);  // 0.1秒待機
    }
    var resStr = execObj.StdOut.ReadLine();
    fso.DeleteFile(tmpFile);
    return resStr;
}

// ----------------

function ReadFile(filename) {
    var fso = WScript.CreateObject("Scripting.FileSystemObject");
    var path = fso.GetAbsolutePathName(filename);
    var MyStr = null;
    if (fso.FileExists(path)) {
        var fobj = fso.OpenTextFile(path, 1);
        MyStr = fobj.ReadAll();
        fobj.Close();
    }
    return MyStr;
}

〜　以上　〜