Excel Book統合

指定したフォルダ内にある複数のブックを１つのブックにまとめる

'--------------------------------------------------------------------------------------
'
'	Excel Book統合
'			(指定したフォルダにあるExcelファイルを１つのファイルにまとめる)
'	
'	注意点	スクリプト実行前にすべてのExcelアプリケーションを終了してください。
'			スクリプト実行中はマウス、キーボードを使用しないでください。
'			このスクリプトが異常終了した場合はExcelのプロセスを手動で終了してください。
'
'--------------------------------------------------------------------------------------
'不要シート削除用定数
const DEL_SHEET_NAME = "delete用ワーク"
'作成されるファイル名
const OUT_FILE_NAME = "result.xls"


targetPath = InputBox("出力対象のディレクトリを入力","ディレクトリの指定","")

if targetPath = "" then
	
	msgbox "出力を中止しました。"

else


	Set Excel  = CreateObject("Excel.Application")
    	Set wkBook = Excel.WorkBooks.Add()

	'不要シートの削除の前処理
	For i = 1 to wkBook.WorkSheets.Count
		wkBook.Sheets(i).name = DEL_SHEET_NAME 
	Next

	'このディレクトリのファイル一覧を取得する
	Set fileSystem   = CreateObject("Scripting.FileSystemObject")
	Set targetFolder = fileSystem.getFolder(targetPath)
	Set fileList = targetFolder.Files

	'ファイルの終端までループ
	For Each wkFile In fileList

		'対象ファイルがExcelならExcelで開く
		if wkFile.type = "Microsoft Excel ワークシート" then

			Set copyBook = Excel.WorkBooks.Open(wkFile)

			'シートの数ループする
			For i = 1 to copyBook.WorkSheets.Count
				copyBook.Sheets(i).Copy(wkBook.Sheets(wkBook.Sheets.Count))
			Next

			copyBook.Close

		end if

	Next

	'不要シートの削除
	For i = 1 to wkBook.WorkSheets.Count
		if wkBook.Sheets(i).name = DEL_SHEET_NAME  then
			wkBook.Sheets(i).delete
		end if
	Next

	'Excelを終了する。
	wkBook.SaveAs targetPath & "\" & OUT_FILE_NAME
	Excel.Quit


	msgbox "出力を完了しました。"

end if

動作確認環境:WindowsXP sp2,Excel2003