ONLY DO WHAT ONLY YOU CAN DO

こけたら立ちなはれ 立ったら歩きなはれ

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

VBScript

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

    'シートを1枚だけにする
    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

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

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

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

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

    'DB接続
    openDB

    '指定フォルダ内の全SQLファイルに対して処理を繰り返す
    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

    'DB切断
    closeDB

    'ブックを保存する
    closeExcel

    Set fs = Nothing
End Sub

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

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