' 仮装テーブルの情報の取得
 Sub Macro1()
     Dim DbName As String, DbPath As String, ConnStr As String
     Dim CN As ADODB.Connection, CAT As ADOX.Catalog
     Dim FSO As Object, Vw As Variant, Ary As Object
     Dim i As Integer, RowObj As Variant
 
     Set FSO = CreateObject("Scripting.FileSystemObject")
     DbName = InputBox("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 Ary = CreateObject("System.Collections.ArrayList")
    For Each Vw In CAT.Views  ' 仮装テーブルを一つずつたどる
        Ary.Add Array(Vw.Name, Vw.Command.CommandText)
    Next
    CN.Close

    ActiveSheet.UsedRange.Clear
    For i = 1 To Ary.Count
        Range(Cells(i, 1), Cells(i, 2)).Value = Ary(i-1)
    Next
    Columns("A").ColumnWidth = 20
    Columns("B").ColumnWidth = 72
    For Each RowObj In ActiveSheet.UsedRange.Rows
        RowObj.AutoFit
    Next
    ActiveSheet.UsedRange.WrapText = True  ' 折り返して全体を表示
End Sub

 ' 仮装テーブルの情報を取得
 Option Explicit
 Dim FSO, Fobj, DbName, DbPath
 Dim ConnStr, CN, CAT, Vw, Ary, i
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 DbName = InputBox("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 Ary = CreateObject("System.Collections.ArrayList")
For Each Vw In CAT.Views  ' 仮装テーブルを一つずつたどる
    Ary.Add Array(Vw.Name, Vw.Command.CommandText)
Next
CN.Close
Set Fobj = FSO.OpenTextFile("ViewInfo.txt", 2, True)
For i = 0 To (Ary.Count-1)
    Fobj.WriteLine Join(Ary(i), vbCrLf)
Next
Fobj.Close

 // 仮装テーブルの情報の取得
 var fso, Fobj, dbName, dbPath;
 var connStr, cn, cat, vw, Ary, i, j;
 
 fso = WScript.CreateObject("Scripting.FileSystemObject");
 dbName = InputBox("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;

Ary = [];
for (i=0; i<cat.Views.Count; i++) {  // 仮装テーブルを一つずつたどる
    vw = cat.Views(i);
    Ary.push([vw.Name, vw.Command.CommandText]);
}
cn.Close();
Fobj = fso.OpenTextFile("ViewInfo.txt", 2, true);
for (i = 0; i < Ary.length; i++) {
    Fobj.WriteLine(Ary[i].join("\n"));
}
Fobj.Close();

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

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

 ' 仮装テーブルをExcelに取り込む(QueryTable利用)
 Sub Macro1()
     Dim DbName As String, DbPath As String, ConnStr As String, sql As String
     Dim FSO As Object, Vw As Variant
     Dim CN As ADODB.Connection, CAT As ADOX.Catalog
     Dim WSobj As Worksheet, SheetCount As Integer, i As Integer
 
     Set FSO = CreateObject("Scripting.FileSystemObject")
     DbName = InputBox("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

    ConnStr = "ODBC;DSN=MS Access Database;DBQ=" & DbPath
    SheetCount = 0
    For Each Vw In CAT.Views  ' 仮装テーブルを一つずつたどる
        sql = Vw.Command.CommandText
        sql = Replace(sql, """", "'")
        SheetCount = SheetCount + 1
        If Worksheets.Count < SheetCount Then  ' シート枚数不足
            Worksheets.Add After:=Worksheets(Worksheets.Count)
        End If
        Set WSobj = Worksheets(SheetCount)  ' 最後のシートに着目
        WSobj.UsedRange.Clear  ' 念のためシートを全クリア
        WSobj.Name = Vw.Name  ' シート名をテーブル名にする
        With WSobj.QueryTables.Add(ConnStr, WSobj.Range("A1"), sql)
            .BackgroundQuery = False  ' バックグラウンド処理をしない
            .Refresh
            .Delete  ' クエリテーブルを削除
        End With
    Next
    CN.Close
    If (SheetCount > 0) And (Worksheets.Count > SheetCount) Then
        Application.DisplayAlerts = False  ' 警告メッセージを抑制
        For i = Worksheets.Count To (SheetCount+1) Step -1
            Worksheets(i).Delete
        Next
        Application.DisplayAlerts = True
    End If
    Worksheets(1).Activate  ' 第１シートをアクティブに
End Sub