' AccessデータベースのテーブルをExcelに取り込む(QueryTable利用)
 Sub Macro1()
     Dim DbName As String, DbPath As String, ConnStr As String, sql As String
     Dim FSO As Object, Tbl As Variant, TblAry As Variant
     Dim WSobj As Worksheet, SheetCount As Integer, i As Integer
 
     Set FSO = CreateObject("Scripting.FileSystemObject")
     DbName = InputBox("Accessファイルの名前：　", _
         "Access→Excel", "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
    TblAry = GetTableInfo(DbPath)

    ConnStr = "ODBC;DSN=MS Access Database;DBQ=" & DbPath
    SheetCount = 0
    For Each Tbl In TblAry  ' AccessのTable情報を一つずつ取り出す
        If (Tbl(1) = "TABLE") Or (Tbl(1) = "VIEW") Then
            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 = Tbl(0)  ' シート名をテーブル名にする
            sql = "select * from [" & Tbl(0) & "];"
            With WSobj.QueryTables.Add(ConnStr, WSobj.Range("A1"), sql)
                .BackgroundQuery = False  ' バックグラウンド処理をしない
                .Refresh
                .Delete  ' クエリテーブルを削除
            End With
        End If
    Next
    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

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

Function GetTableInfo(ByVal DbPath As String)
    Dim ConnStr As String
    Dim CN As ADODB.Connection, CAT As ADOX.Catalog
    Dim Tbl As Variant, TblAry() As Variant, TblCount As Long

    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

    TblCount = 0
    For Each Tbl In CAT.Tables  ' テーブルを一つずつたどる
        ReDim Preserve TblAry(TblCount)
        TblAry(TblCount) = Array(Tbl.Name, Tbl.Type, _
            Tbl.DateCreated, Tbl.DateModified)
        TblCount = TblCount + 1
    Next
    CN.Close
    GetTableInfo = TblAry
End Function

 ' AccessデータベースのテーブルをExcelに取り込む(QueryTable利用)
 Option Explicit
 Dim FSO, DbName, DbPath, BookName, BookPath
 Dim ConnStr, Tbl, TblAry, sql
 Dim EXLapp, WBobj, WSobj, SheetCount, i
 Const xlWorkbookNormal = -4143
 BookName = "Book1.xls"
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
DbName = InputBox("Accessファイルの名前：　", _
    "Access→Excel", "TestDB.mdb")
If DbName = "" Then WScript.Quit
DbPath = FSO.GetAbsolutePathName(DbName)
If FSO.FileExists(DbPath) = False Then
    MsgBox "ファイルがみつかりません: " & DbPath
    WScript.Quit
End If
TblAry = GetTableInfo(DbPath)
BookPath = FSO.GetAbsolutePathName(BookName)
If FSO.FileExists(BookPath) Then FSO.DeleteFile(BookPath)
Set EXLapp = CreateObject("Excel.Application")  ' Excelの起動
EXLapp.Visible = True  ' Excelを見える状態に
Set WBobj = EXLapp.Workbooks.Add()  ' Workbookの新規作成

ConnStr = "ODBC;DSN=MS Access Database;DBQ=" & DbPath
SheetCount = 0
For Each Tbl In TblAry
    If (Tbl(1) = "TABLE") Or (Tbl(1) = "VIEW") Then
        SheetCount = SheetCount + 1
        If WBobj.Worksheets.Count < SheetCount Then  ' シート枚数不足
            WBobj.Worksheets.Add Null, WBobj.Worksheets(WBobj.Worksheets.Count)
        End If
        Set WSobj = WBobj.Worksheets(SheetCount)  ' 最後のシートに着目
        WSobj.Name = Tbl(0)  ' シート名をテーブル名にする
        sql = "select * from [" & Tbl(0) & "];"
        With WSobj.QueryTables.Add(ConnStr, WSobj.Range("A1"), sql)
            .BackgroundQuery = False  ' バックグラウンド処理をしない
            .Refresh
            .Delete  ' クエリテーブルを削除
        End With
    End If
Next
If (SheetCount > 0) And (WBobj.Worksheets.Count > SheetCount) Then
    EXLapp.DisplayAlerts = False  ' 警告メッセージを抑制
    For i = WBobj.Worksheets.Count To (SheetCount+1) Step -1
        WBobj.Worksheets(i).Delete
    Next
    EXLapp.DisplayAlerts = True
End If
WBobj.Worksheets(1).Activate  ' 第１シートをアクティブに
WBobj.SaveAs BookPath, xlWorkbookNormal
EXLapp.quit

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

Function GetTableInfo(ByVal DbPath)
    Dim CN, ConnStr, CAT
    Dim Tbl, TblAry(), TblCount

    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
    TblCount = 0
    For Each Tbl In CAT.Tables
        ReDim Preserve TblAry(TblCount)
        TblAry(TblCount) = Array(Tbl.Name, Tbl.Type, _
            Tbl.DateCreated, Tbl.DateModified)
        TblCount = TblCount + 1
    Next
    CN.Close
    GetTableInfo = TblAry
End Function

  // AccessデータベースのテーブルをExcelに取り込む(QueryTable利用)
  var fso, dbName, dbPath, bookName, bookPath;
  var connStr, tbl, tblAry, tn, sql;
  var ExlApp, wb, ws, sheetCount, i;
  var xlWorkbookNormal = -4143;
  bookName = "Book1.xls";
  
  fso = WScript.CreateObject("Scripting.FileSystemObject");
  dbName = InputBox("Accessファイルの名前：　",
     "Access→Excel", "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();
 }
 tblAry = getTableInfo(dbPath);
 bookPath = fso.GetAbsolutePathName(bookName);
 if (fso.FileExists(bookPath) == true)  fso.DeleteFile(bookPath);
 ExlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
 ExlApp.Visible = true;  // Excelを見える状態に
 wb = ExlApp.Workbooks.Add();  // Workbookの新規作成
 
 connStr = "ODBC;DSN=MS Access Database;DBQ=" + dbPath;
 sheetCount = 0;
 for (tn = 0; tn < tblAry.length; tn++) {
     tbl = tblAry[tn];
     if (tbl[1] == "TABLE" || tbl[1] == "VIEW") {
         sheetCount = sheetCount + 1;
         if (wb.Worksheets.Count < sheetCount) {  // シート枚数不足
             wb.Worksheets.Add(null, wb.Worksheets(wb.Worksheets.Count));
         }
         ws = wb.Worksheets(sheetCount);  // 最後のシートに着目
         ws.Name = tbl[0];  // シート名をテーブル名にする
         sql = "select * from [" + tbl[0] + "];";
         with (ws.QueryTables.Add(connStr, ws.Range("A1"), sql)) {
             BackgroundQuery = false;  // バックグラウンド処理をしない
             Refresh();
             Delete();  // クエリテーブルを削除
         }
     }
 }
 if (sheetCount > 0 && wb.Worksheets.Count > sheetCount) {
     ExlApp.DisplayAlerts = false;  // 警告メッセージを抑制
     for (i=wb.Worksheets.Count; i>sheetCount; i--) {
         wb.Worksheets(i).Delete();
     }
     ExlApp.DisplayAlerts = true;
 }
 wb.Worksheets(1).Activate;  // 第１シートをアクティブに
 wb.SaveAs(bookPath, xlWorkbookNormal);
 ExlApp.Quit();
 
 // ----------------
 
 function getTableInfo(dbPath) {
     var cn, connStr, cat;
     var tbl, tblAry, tblCount, i;
 
     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;
     tblCount = cat.Tables.Count;
     tblAry = Array(tblCount);
     for (i = 0; i < tblCount; i++) {
         tbl = cat.Tables(i);
         tblAry[i] = [tbl.Name, tbl.Type,
             tbl.DateCreated, tbl.DateModified];
     }
     cn.Close();
     return tblAry;
 }
 
 // ----------------
 
 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;
}