【VBScript】SQLServerに接続してSQL(SELECT)を実行しCSVに出力

以前に以下のサンプルコードを紹介しましたが、

【VBScript】SQLServerに接続してSQL(SELECT)を実行

今回はこの発展系で、且つ需要があると思われる、SELECTで取得したデータをCSVファイルに出力するサンプルコードを紹介させて頂きます。

Option Explicit
 
Call Main()
 
	Sub Main()
	
		Dim objCon
		Dim query
		Dim objRS
		Dim srvName, dbName, loginName, loginPass
		
		Dim objFS			'CSV出力で使用するオブジェクト変数
		Dim CsvFileFullName	'CSVファイルの出力先※ファイル名を含むフルパス
		Dim objOutputCsv	'CSVの書き込みで使用するオブジェクト変数
 
			'データベース接続情報を定義します。'
			srvName = "DBサーバ名"
			dbName = "DB名"
			loginName = "DBユーザ名"
			loginPass = "DBパスワード"
			
			'CSVの出力先を定義します。
			CsvFileFullName = "C\:テスト出力先\テスト.CSV"
 
		'SQLServerへ接続します。***************************************************************************************************
		On Error Resume Next
			Set objCon = CreateObject("ADODB.Connection")
			objCon.Open "Driver={SQL Server}; server=" & srvName & "; database=" & dbName & "; uid=" & loginName & "; pwd=" & loginPass & ";"
 
		'エラー処理'
		If Err.Number <> 0 Then
			Msgbox("エラーが発生しました。　　" & "　エラーナンバー:" & Err.Number & "　エラー詳細：" & Err.Description)
			Set objCon = Nothing
			Exit Sub
		End If
		Err.Clear
		On Error Goto 0
		
		'SQLを実行してレコードセットに格納します。*********************************************************************************
 
			query = ""
			query = query & "SELECT "
			query = query & "	カラム1 "
			query = query & "	,カラム2 "
			query = query & "	,カラム3 "
			query = query & "FROM テーブル名 "
			query = query & "WHERE "
			query = query & "	 カラム1 = xx"
 
		On Error Resume Next
			'定義したSQLを実行してレコードセットに格納します。'
			Set objRS = objCon.Execute(query)
 
		'エラー処理'
		If Err.Number <> 0 Then
			Msgbox("エラーが発生しました。　　" & "　エラーナンバー:" & Err.Number & "　エラー詳細：" & Err.Description)
			objCon.Close
			Set objRS = Nothing
			Set objCon = Nothing
			Exit Sub
		End If
		Err.Clear
		On Error Goto 0
 
		'レコードセットのデータを表示します。***************************************************************************************
		On Error Resume Next
			'レコードセットのデータ件数が0件の場合は処理を終了します。
			If objRS.EOF Then
				Msgbox("対象データが存在しない為、処理を終了します。")
				objCon.Close
				Set objRS = Nothing
				Set objCon = Nothing
				Exit Sub
			End If
 
			'FileSystemObjectを生成します。
			Set objFS = CreateObject("Scripting.FileSystemObject")

			'空のCSVファイルを作成します。
			objFS.CreateTextFile CsvFileFullName, True

			'CSVファイルを開いてデータを書き込める状態にします。引数2の2は上書き可の指定、Trueはファイルがパスに存在しなければ新規作成
			Set objOutputCsv = objFS.OpenTextFile(CsvFileFullName, 2, True)

			'レコードセットの行数分ループします。
			Do Until objRS.EOF
				'一行ずつレコードセットのデータをCSVファイルに書き込みます。
				objOutputCsv.WriteLine objRS("カラム1").Value & "," & objRS("カラム2").Value & "," & objRS("カラム3").Value
				'次のレコードセットに移動します。
				objRS.MoveNext
			Loop
 
		'エラー処理'
		If Err.Number <> 0 Then
			Msgbox("エラーが発生しました。　　" & "　エラーナンバー:" & Err.Number & "　エラー詳細：" & Err.Description)
			objCon.Close
			Set objRS = Nothing
			Set objCon = Nothing
			
			Set objFS = Nothing
			objOutputCsv.Close	'開いたCSVファイルを閉じます。
			Set objOutputCsv = Nothing
			
			Exit Sub
		End If
		Err.Clear
		On Error Goto 0
 
		'終了処理をします。。*******************************************************************************************************
			'オブジェクトを破棄します。
			objCon.Close
			Set objRS = Nothing
			Set objCon = Nothing

			Set objFS = Nothing
			objOutputCsv.Close			'開いたCSVファイルを閉じます。
			Set objOutputCsv = Nothing
	
	End Sub

SQL実行→CSV出力の連携は実業務でも定番の処理ですので、参考にして頂ければ幸いです。