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ありがとうございます。コードを記載したつもりでしたが、記載がされてませんでした。