' ADOによるAccess→Excelの変換
 Option Explicit
 Dim FSO, DbName, DbPath, BookName, BookPath
 Dim Mdb, Xls, MdbTbl, XlsTbl, TblName, FldNames
 Dim MdbRS, XlsRS, MdbCol, XlsCol, i
 
 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
Set Mdb = New DbAdo
Mdb.Open DbPath

BookName = "Book1.xls"
BookPath = FSO.GetAbsolutePathName(BookName)
If FSO.FileExists(BookPath) Then FSO.DeleteFile(BookPath)
Set Xls = New DbAdo
Xls.Open BookPath

For Each MdbTbl In Mdb.CAT.Tables  ' テーブルを一つずつたどる
    If (MdbTbl.Type = "TABLE") Or (MdbTbl.Type = "VIEW") Then
        TblName = "[" & MdbTbl.Name & "]"
        FldNames = FieldNamesNotBin(Mdb.CN, TblName)
        Set XlsTbl = CreateObject("ADOX.Table")  ' 新Tableオブジェクト
        XlsTbl.Name = MdbTbl.Name  ' テーブル名をコピー
        For i = 0 To UBound(FldNames)  ' フィールドを一つずつ
            Set MdbCol = MdbTbl.Columns(FldNames(i))
            Set XlsCol = CreateObject("ADOX.Column")  ' 新Fieldオブジェクト
            XlsCol.Name = MdbCol.Name
            XlsCol.Type = MdbCol.Type
            XlsCol.DefinedSize = MdbCol.DefinedSize
            XlsCol.Precision = MdbCol.Precision
            XlsCol.NumericScale = MdbCol.NumericScale
            XlsCol.ParentCatalog = Xls.CAT  ' 念のため
            XlsTbl.Columns.Append XlsCol  ' Field定義をTableに追加
        Next
        Xls.CAT.Tables.Append XlsTbl  ' ここでTableの定義が完了
    Set MdbRS = CreateObject("ADODB.Recordset")
        MdbRS.Open TblName, Mdb.CN, 0, 1, 2
        Set XlsRS = CreateObject("ADODB.Recordset")
        XlsRS.Open TblName, Xls.CN, 0, 2, 2
        Do Until MdbRS.EOF  ' mdbのレコードをxlsにコピー
            XlsRS.AddNew
            For i = 0 To UBound(FldNames)
                XlsRS.Fields(FldNames(i)).Value = _
                    MdbRS.Fields(FldNames(i)).Value
            Next
            XlsRS.Update
            MdbRS.MoveNext
        Loop
        MdbRS.Close
        XlsRS.Close
    End If
Next
Xls.Close
Mdb.Close
ExcelAutoFit BookPath

 Function FieldNamesNotBin(CN, TblName)  ' フィールド名の取得
     Dim RS, FldNames, FldCount, ValStr, i
     Set RS = CreateObject("ADODB.Recordset")
     RS.Open TblName, CN, 0, 1, 2
     Set FldNames = CreateObject("System.Collections.ArrayList")
     FldCount = RS.Fields.Count
     For i = 0 To (FldCount-1)
         ValStr = "@" & CStr(RS.Fields(i).Type) & "@"
         If InStr("@128@204@205@", ValStr) = 0 Then  ' バイナリではない
            FldNames.Add RS.Fields(i).Name
        End If
    Next
    RS.Close
    FieldNamesNotBin = FldNames.ToArray()
End Function

 Class DbAdo
     Public DbPath
     Public ConnStr
     Public CN
     Public CAT
 
     Private Sub Class_Initialize
         DbPath = ""
         ConnStr = ""
        Set CN = Nothing
        Set CAT = Nothing
    End Sub

    Private Sub Class_Terminate
        Call Close()
    End Sub

    Public Sub Open(ByVal DbName)  ' DataBase open
        Dim ShellObj, FSO, DriverStr, ExtName
        Set ShellObj = CreateObject("Wscript.Shell")
        If ShellObj.Environment("Process").Item( _
                "PROCESSOR_ARCHITECTURE") = "x86" Then  ' 32bit版の場合
            DriverStr = "Provider=Microsoft.Jet.OLEDB.4.0;"
        Else  ' 64bit版の場合
            DriverStr = "Provider=Microsoft.ACE.OLEDB.12.0;"
        End If
        Set ShellObj = Nothing
        Set FSO = CreateObject("Scripting.FileSystemObject")
        DbPath = FSO.GetAbsolutePathName(DbName)
        ExtName = LCase(FSO.GetExtensionName(DbPath))
        Select Case ExtName
        Case "mdb"
            ConnStr = DriverStr & "Data Source=" & DbPath & ";"
        Case "xls"
            ConnStr = DriverStr & "Data Source=" & DbPath & ";" & _
                "Extended Properties=""Excel 8.0;HDR=Yes;"""
        Case "accdb"
            ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & DbPath & ";"
        Case "xlsx"
            ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & DbPath & ";" & _
                "Extended Properties=""Excel 12.0 XML;HDR=Yes;"""
        Case Else
            ConnStr = ""
        End Select
        If ConnStr = "" Then
            Set CN = Nothing
            Set CAT = Nothing
            Exit Sub
        End If
        If (FSO.FileExists(DbPath) = False) And ((ExtName = "mdb") Or _
            (ExtName = "accdb")) Then
            Set CAT = CreateObject("ADOX.Catalog")
            Set CN = CAT.Create(ConnStr)  ' データベース新規作成
        Else
            Set CN = CreateObject("ADODB.Connection")
            CN.Open ConnStr
            Set CAT = CreateObject("ADOX.Catalog")
            CAT.ActiveConnection = CN
        End If
        Set FSO = Nothing
    End Sub

    Public Sub Close()
        If Not CN Is Nothing Then CN.Close
        DbPath = ""
        ConnStr = ""
        Set CN = Nothing
        Set CAT = Nothing
    End Sub
End Class

  // ADOによるAccess→Excelの変換
  var fso, dbName, dbPath, bookName, bookPath;
  var mdb, xls, mdbTbl, xlsTbl, tblName, fldNames;
  var mdbRs, xlsRs, mdbCol, xlsCol, i, k;
  
  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();
 }
 mdb = new DbAdo(dbPath);
 
 bookName = "Book1.xls";
 bookPath = fso.GetAbsolutePathName(bookName);
 if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
 xls = new DbAdo(bookPath);
 
 for (k=0; k<mdb.cat.Tables.Count; k++) {  // テーブルを一つずつたどる
     mdbTbl = mdb.cat.Tables(k);
     if (mdbTbl.Type == "TABLE" || mdbTbl.Type == "VIEW") {
         tblName = "[" + mdbTbl.Name + "]";
         fldNames = FieldNamesNotBin(mdb.cn, tblName);
         xlsTbl = WScript.CreateObject("ADOX.Table");
         xlsTbl.Name = mdbTbl.Name
         for (i=0; i<fldNames.length; i++) {  // フィールドを一つずつ
             mdbCol = mdbTbl.Columns(fldNames[i]);
             xlsCol = WScript.CreateObject("ADOX.Column");
             xlsCol.Name = mdbCol.Name;
             xlsCol.Type = mdbCol.Type;
             xlsCol.DefinedSize = mdbCol.DefinedSize;
             xlsCol.Precision = mdbCol.Precision;
             xlsCol.NumericScale = mdbCol.NumericScale;
             xlsCol.ParentCatalog = xls.cat;  // 念のため
             xlsTbl.Columns.Append(xlsCol);  // Field定義をTableに追加
         }
         xls.cat.Tables.Append(xlsTbl);  // ここでTableの定義が完了
         mdbRs = WScript.CreateObject("ADODB.Recordset");
         mdbRs.Open(tblName, mdb.cn, 0, 1, 2);
         xlsRs = WScript.CreateObject("ADODB.Recordset");
         xlsRs.Open(tblName, xls.cn, 0, 2, 2);
         while (mdbRs.EOF == false) {
             xlsRs.AddNew();
             for (i=0; i<fldNames.length; i++) {
                 xlsRs.Fields(fldNames[i]).Value =
                     mdbRs.Fields(fldNames[i]).Value;
             }
             xlsRs.Update();
             mdbRs.MoveNext();
         }
         mdbRs.Close();
         xlsRs.Close();
     }
 }
 xls.close();
 mdb.close();
 ExcelAutoFit(bookPath);
 
 // ----------------
 
 function FieldNamesNotBin(cn, tblName) {
     var rs, fldNames, fldCount, valStr, i;
     rs = WScript.CreateObject("ADODB.Recordset");
     rs.Open(tblName, cn, 0, 1, 2);
     fldNames = [];
     fldCount = rs.Fields.Count;
     for (i=0; i<fldCount; i++) {
         valStr = "@" + rs.Fields(i).Type + "@";
         if ("@128@204@205@".indexOf(valStr) == -1) {  // バイナリではない
             fldNames.push(rs.Fields(i).Name);
         }
     }
     rs.Close();
     return fldNames;
 }
 
 // ----------------
 
 function DbAdo(dbName) {
     this.dbPath = "";
     this.connStr = "";
     this.cn = null;
     this.cat = null;
     this.open = DbAdo_open;
     this.close = DbAdo_close;
     this.open(dbName);
 }
 
 // ----------------
 
 function DbAdo_open(dbName) {
     var shellObj, driverStr, fso, extName;
    shellObj = WScript.CreateObject("Wscript.Shell");
    if (shellObj.Environment("Process").Item(
            "PROCESSOR_ARCHITECTURE") == "x86") {  // 32bit版の場合
        driverStr = "Provider=Microsoft.Jet.OLEDB.4.0;";
    } else {  // 64bit版の場合
        driverStr = "Provider=Microsoft.ACE.OLEDB.12.0;";
    }
    fso = WScript.CreateObject("Scripting.FileSystemObject");
    this.dbPath = fso.GetAbsolutePathName(dbName);
    this.connStr = "";
    extName = fso.GetExtensionName(this.dbPath).toLowerCase();
    switch (extName) {
    case "mdb":
        this.connStr = driverStr + "Data Source=" + this.dbPath + ";";
        break;
    case "xls":
        this.connStr = driverStr + "Data Source=" + this.dbPath + ";" +
            "Extended Properties=\"Excel 8.0;HDR=Yes;\"";
        break;
    case "accdb":
        this.connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" +
            "Data Source=" + this.dbPath + ";";
        break;
    case "xlsx":
        this.connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" +
            "Data Source=" + this.dbPath + ";" +
            "Extended Properties=\"Excel 12.0 XML;HDR=Yes;\"";
        break;
    }
    if (this.connStr == "") {
        this.cn = null;
        this.cat = null;
        return;
    }
    if (fso.FileExists(this.dbPath) == false && (extName == "mdb" ||
        extName == "accdb")) {
        this.cat = WScript.CreateObject("ADOX.Catalog");
        this.cn = this.cat.Create(this.connStr);  // データベース新規作成
    } else {
        this.cn = WScript.CreateObject("ADODB.Connection");
        this.cn.Open(this.connStr);
        this.cat = WScript.CreateObject("ADOX.Catalog");
        this.cat.ActiveConnection = this.cn;
    }
}

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

function DbAdo_close() {
    if (this.cn != null)  this.cn.Close();
    this.dbPath = "";
    this.connStr = "";
    this.cn = null;
    this.cat = null;
}

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

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 ExcelAutoFit(bookPath) {  // 全シートのセル幅を調整
    var ExlApp, wb, ws, i, j;
    ExlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
    ExlApp.Visible = true;  // Excelを見える状態に
    wb = ExlApp.Workbooks.Open(bookPath);
    for (i=1; i<=wb.Worksheets.Count; i++) {
        ws = wb.Worksheets(i);
        ws.UsedRange.Columns.AutoFit();
    }
    wb.Save;  // ワークブックの上書き保存
    ExlApp.Quit();
}