複数のブック、シートのセルの値を出力する

指定したフォルダ内にあるExcelファイルのセルの内容をテキスト(CSV)に出力する

'--------------------------------------------------------------------------------------
'
'	Excel 値出力
'			(指定したフォルダにあるExcelファイルのセルの値を出力する)
'	
'	注意点	スクリプト実行前にすべてのExcelアプリケーションを終了してください。
'			スクリプト実行中はマウス、キーボードを使用しないでください。
'			このスクリプトが異常終了した場合はExcelのプロセスを手動で終了してください
'
'			★の部分は動作環境・目的に応じて書き換えること
'
'--------------------------------------------------------------------------------------

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

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

else

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

	'結果を出力するファイルを作成する
	Set resultfile = fileSystem.CreateTextFile(targetPath & "\" & "result.txt",True)


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

		'対象ファイルがExcelならExcelで開く★(Excelのバージョンによっては書き換える必要がある)
		if wkFile.type = "Microsoft Excel 97-2003 ワークシート" then

			Set Excel  = CreateObject("Excel.Application")

			Set wkBook = Excel.WorkBooks.Open(wkFile)
			
			'シートの数ループする
			For i = 1 to wkBook.WorkSheets.Count
				
				Set xlsSheet = wkBook.WorkSheets(i)

				'シートのセルの値を出力
				Call propatetyOutput(wkFile.Name,xlsSheet)

			Next

			'Excelを終了する。
			wkBook.Close savechanges=false
			Excel.Quit

		end if

	Next

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

end if

'--------------------------------------------------------------------------------------
'
'	セルの値を出力する
'
'--------------------------------------------------------------------------------------
Sub propatetyOutput(bookName,paraSheet)

xlCellTypeLastCell	=	11


    iRow =0

    '★出力したくないシートがある場合はここで条件を指定
    if instr(paraSheet.Name,"版") <> 0 THEN

        lastRow = paraSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

        '★出力する行を指定
    	for iRow = 57 to lastRow

            '★出力する条件を指定(空白のセルは出力しない)
            if TRIM(paraSheet.Cells(iRow,5))  <> ""  THEN 

            	resultVal = ""

            	resultVal = resultVal & bookName									& ","
            	resultVal = resultVal & paraSheet.Name								& ","

                '★出力する列を列挙
                resultVal = resultVal & paraSheet.Cells(iRow,3) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,5) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,12) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,14) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,16) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,17) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,18) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,20) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,28) & ","
                resultVal = resultVal & paraSheet.Cells(iRow,34) & ","

                resultfile.WriteLine resultVal

            END IF

            

    	next

   END IF
	

End Sub

動作確認環境:Excel2010