|
▼夜勤担当 さん:
こんにちは。。
>
> 複数のExcelファイル(タイトル同じ)をひとつのファイルに丸めることは
>可能でしょうか?
>
>ファイル数:15
>レコード数:1500明細/ファイル
ADOを使ってやってみました。
Microsoft ActiveX Data Object X.X Library
へ参照設定
シート名は全て Sheet1 でタイトルも全部同じとして
保存ディレクトリの中のエクセルを全部読込みます。
Sub Temp3()
Dim cn As ADODB.Connection
Dim strFnm As String
Dim strDir As String
Dim strSnm As String
Dim strSQL As String
'ブックをデータベースとして接続書込みするエクセルファイル
strFnm = ThisWorkbook.FullName
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Data Source").Value = strFnm
.Properties("Extended Properties").Value = "Excel 8.0"
End With
cn.Open
' 読込みするエクセルのディレクトリ
strDir = ThisWorkbook.Path & "\AAA\"
' 読込みするエクセルのファイル名に * を付ける(Loopする為)
strSnm = strDir & "*Sample*.xls"
' Dir のお決まり
strSnm = Dir(strSnm)
Do While strSnm <> ""
'追加クエリー実行
strSQL = "INSERT INTO [Sheet1$] " & _
"SELECT * FROM [Sheet1$] " & _
"IN '" & strDir & strSnm & "' " & _
"'Excel 8.0;HDR=YES'"
cn.Execute CommandText:=strSQL
strSnm = Dir()
Loop
'オブジェクト変数の解放
cn.Close
Set cn = Nothing
End Sub
|
|