VBScriptでフォルダ内のSQLを読んで実行結果をExcelに出力する

gistfile1.vb

Option Explicit

Private fs
Private conn
Private excelApp
Private excelBook
Private excelSheet

'出力シートの準備
Private Sub openSheet(iSheet, sqlFile)
	'必要なら、シートを追加する
	If iSheet > excelBook.WorkSheets.Count Then
		excelBook.Sheets.Add , excelBook.WorkSheets(iSheet - 1)
	End If
	Set excelSheet = excelBook.WorkSheets(iSheet)

	'シート名を設定する
	excelSheet.Name = Replace(UCase(sqlFile.Name), ".SQL", "")
End Sub

'シート書式設定
Private Sub closeSheet()
'	excelSheet.Cells.EntireColumn.AutoFit
	With excelSheet.Cells.Font
		.Name = "MeiryoKe_Console"
		.Size = 10
		.Strikethrough = False
		.Superscript = False
		.Subscript = False
		.OutlineFont = False
		.Shadow = False

		.Name = "Consolas"
		.Size = 10
	End With

	With excelSheet.Rows("1:1")
		.Font.ColorIndex = 2
		.Interior.ColorIndex = 55
	End With
End Sub

'結果出力
Private Sub writeResult(rs, iSheet, sqlFile)
	'出力シートの準備
	Call openSheet(iSheet, sqlFile)

	'項目名 出力
	Dim iRow: iRow = 1
	Dim iCol
	For iCol = 1 To rs.Fields.Count
		excelSheet.Cells(iRow, iCol).Value = rs.Fields(iCol - 1).Name & ""
	Next

	'値 出力
	Do Until rs.EOF
		iRow = iRow + 1
		For iCol = 1 To rs.Fields.Count
			excelSheet.Cells(iRow, iCol).Value = "'" & rs.Fields(iCol - 1).Value
		Next

		rs.MoveNext
	Loop

	'シート書式設定
	closeSheet
End Sub

'SQL 読み込み
Private Function getSql(sqlFile)
'	WScript.Echo sqlFile.Path
	WScript.Echo sqlFile.Name

	Dim tsSql:   Set tsSql = fs.OpenTextFile(sqlFile.Path)
	Dim sqlText: sqlText   = tsSql.ReadAll
'	WScript.Echo sqlText
	tsSql.Close
	Set tsSql = Nothing

	getSql = sqlText
End Function

'SQL 実行
Private Function openRecordSet(sqlText)
	Dim rs: Set rs = CreateObject("ADODB.Recordset")
	With rs
		.ActiveConnection = conn
		.CursorType       = 0 'adOpenForwardOnly
		.LockType         = 1 'adLockReadOnly
		.Source           = sqlText
		.Open
	End With

	Set openRecordSet = rs
End Function

'ブックを書き込み用で開く
Private Sub openExcel()
	Set excelApp = CreateObject("Excel.Application")
	excelApp.Visible       = True
	excelApp.DisplayAlerts = False '警告メッセージをOFF

	Set excelBook = excelApp.Workbooks.Add

	'シートを１枚だけにする
	Dim iSheet
	For iSheet = excelBook.WorkSheets.Count To 2 Step -1
		excelBook.WorkSheets(iSheet).Delete
	Next
End Sub

'ブックを保存する
Private Sub closeExcel()
	excelBook.SaveAs(WScript.Arguments(1))
	excelApp.Quit 
	Set excelApp = Nothing
End Sub

'ＤＢ接続
Private Sub openDB()
	Set conn = CreateObject("ADODB.Connection")
	conn.Open "aaaaa","bbbbb","ccccc"
End Sub

'ＤＢ切断
Private Sub closeDB()
	conn.Close
	Set conn = Nothing
End Sub

'主処理
Private Sub Main()
	Set fs = CreateObject("Scripting.FileSystemObject")

	'ブックを書き込み用で開く
	openExcel

	'ＤＢ接続
	openDB

	'指定フォルダ内の全ＳＱＬファイルに対して処理を繰り返す
	Dim sqlFolder: Set sqlFolder = fs.GetFolder(WScript.Arguments(0))
	Dim sqlFile
	Dim iSheet: iSheet = 0
	For Each sqlFile In sqlFolder.Files
		'SQL 読み込み
		Dim sqlText: sqlText = getSql(sqlFile)
		'SQL 実行
		Dim rs: Set rs = openRecordSet(sqlText)
		'結果出力
		iSheet = iSheet + 1
		Call writeResult(rs, iSheet, sqlFile)
		rs.Close
		Set rs = Nothing
	Next
	Set sqlFile   = Nothing
	Set sqlFolder = Nothing

	'ＤＢ切断
	closeDB

	'ブックを保存する
	closeExcel

	Set fs = Nothing
End Sub

'主処理 呼び出し
Call Main()

'実行形式
'cscript //nologo OracleToExcel.vbs "C:\sql_folder" "c:\result.xls"