windows10 office 2016環境での.vbs

Question

データフォルダの中にある、エクセルが例えば1つであれば、ポップアップは

Comments

[imihito]

①vbsのコードを提示してください。②「使用できなくなりました」とありますが「動くけれど意図しない動作をする」・「途中で○○というエラーが発生して止まる」などより詳細な情報を提示してください。

[退会済みユーザー]

Option Explicit Const DIR = "C:\Temp\***\***\data" Const XLS = "C:\Temp\***\***\***.xlsx" Marge Sub Marge Dim cn Dim rs Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0" Dim fs Set fs = CreateObject("Scripting.FileSystemObject") Dim folder Set folder = fs.GetFolder( DIR ) Dim file 'エラーカウンター Dim cnt cnt = 0 For Each file In folder.Files 'WScript.Echo file On Error Resume Next cn.Execute "INSERT INTO [Sheet1$] SELECT * FROM [Excel 16;database=" & file & "].[***$A3:AI4]" If Err.Number = 0 Then 'WScript.Echo "OK" Else cnt = cnt + 1 'WScript.Echo "Error!! 修正して下さい:" & file Dim objExcel '************* Set objExcel = CreateObject("Excel.Application") '************* objExcel.Visible = True '************* objExcel.Workbooks.Open file '************* Set objExcel = Nothing End If Nextありがとうございます。コードを記載したつもりでしたが、記載がされてませんでした。

[imihito]

そのコードは質問に追記してください。こちらに書かれても初期状態だと隠れている＆フォーマットが崩れるで二重に見にくいです。

[退会済みユーザー]

失礼いたしました。質問に記載いたしました。

Answer 1

私の環境は以下の通りです
Windows 10 Pro 64bit
MS Office 365 Solo (2016 64bit)

コード側の問題

cn.Openやcn.Executeの引数内のExcel ~といった文字列ですが、これはExcelのバージョンを示すものではありません。

ここに指定するのはISAM形式、ざっくりとしたイメージでは「ファイルの形式」となります。
今回対象ファイルがxlsx、Excel 2007（=Excel 12.0）の形式となるためExcel 12.0を指定します。

私の環境の場合、VBAから実行する場合は上記の変更とMicrosoft.ACE.OLEDBのバージョンを指定すれば動きましたが、VBScriptから実行する場合は次の操作が必要になりました。

Accessのエンジンのインストール

以下のページからAccessのエンジンをダウンロード・インストールし、プロバイダをMicrosoft.ACE.OLEDB.12.0に変更することでVBScriptからでも実行できるようになりました。

Download Microsoft Access データベース エンジン 2010 再頒布可能コンポーネント from Official Microsoft Download Center

こちらのエンジンですが、32bit/64bitが共存できないため、どちらかを選択する必要があります。

私は上記の通りOfficeも64bitでインストールしているため、64bit版をインストールしましたが、起動方法なども鑑みて選択してください。

Option Explicit

Const DIR = "C:\Temp**\data" 
Const XLS = "C:\Temp*****.xlsx"

Call Merge

Sub Merge()

Dim cn 'As ADODB.Connection
Set cn = CreateObject("ADODB.Connection")

'Provider・Extended Propertiesの指定の変更
Dim connectionString 'As String
connectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & XLS & ";" & _
    "Extended Properties=Excel 12.0"

cn.Open connectionString

Dim fso 'As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder 'As Scripting.Folder
Set folder = fso.GetFolder(DIR)

Dim file 'As Scripting.File
'エラーカウンター
Dim cnt
For Each file In folder.Files
    WSH.Echo file.Path
    On Error Resume Next
        cn.Execute "INSERT INTO [Sheet1$] SELECT * FROM [Excel 12.0;database=" & file.Path & "].[***$A3:AI4]"
        If Err.Number = 0 Then
            WSH.Echo "OK"
        Else
            cnt = cnt + 1
            WSH.Echo Err.Description
            WSH.Echo "Error!! 修正して下さい:" & file.Path
            With CreateObject("Excel.Application")
                .Visible = True
                .Workbooks.Open file.Path
            End With
            Err.Clear
        End If
    On Error GoTo 0
Next 'file
End Sub

Comments

[退会済みユーザー]

ありがとうございます。
大変勉強になります。
ちゃんと理解できていないところもあり、噛み砕いております。

また質問させていただく際はよろしくお願いいたします。