復旧・復興支援制度DBから地方公共団体（コードおよび名称）の情報を取得し、CSVファイルに出力するVBScript

この間の続き。これから、出かけるので、今日作成の分を置いておきます。

Option Explicit

'************************************************************
'定数
'************************************************************
'' 保存先のCSVファイル名
Const CSV_FILE_NAME = "Municipalities.csv"

'' 地方公共団体のXMLを取得するURL
Const MUNICIPALITIES_URL = "http://api.r-assistance.go.jp/v1/api.svc/getMunicipalities?appkey=0&prefcode="
'' 地方公共団体のXMLファイルにつける接頭辞
Const MUNICIPALITIES_PREFIX = "Municipalities_"

'************************************************************

Dim oXMLHTTP   ' XMLHTTPオブジェクト
Dim objXML     ' XMLオブジェクト
Dim objFSO     ' ファイルシステムオブジェクト

Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
Set objXML   = CreateObject("MSXML2.DOMDocument")
Set objFSO   = WScript.CreateObject("Scripting.FileSystemObject")

Call Main()
WScript.Echo "終了しました"

Set oXMLHTTP = Nothing
Set objXML   = Nothing
Set objFSO   = Nothing

'************************************************************
' メイン処理
'************************************************************
Sub Main()
	Dim oCsvFile       ' CSVファイル
	Dim csvTextStream  ' CSVファイルの出力ストリーム
	Dim i
	Dim prefcode
	Dim saveFileName

	' 既存のCSVファイルが存在すれば、削除
	if objFSO.FileExists(CSV_FILE_NAME) Then
		objFSO.DeleteFile CSV_FILE_NAME
	End if

	' CSVファイルを作成
	objFSO.CreateTextFile CSV_FILE_NAME
	Set oCsvFile = objFSO.GetFile(CSV_FILE_NAME)
	' 8:追記モード, -2:システムデフォルト文字コード SJISで
	Set csvTextStream = oCsvFile.OpenAsTextStream(8, -2)

	' 47都道府県
	For i = 1 To 47
		' 2桁の数字に変換 ※VBScriptではFormat関数使えない
		If i < 10 Then
			prefcode = 0 & i
		Else
			prefcode = i
		End If

		saveFileName = MUNICIPALITIES_PREFIX & prefcode & ".xml"

		If GetMunicipalities(prefcode, saveFileName) <> 0 Then
			WScript.Echo "地方公共団体コードの取得に失敗しました"
			Exit For
		End If

		' CSVファイルに出力
		Call ConvertMunicipalities2Csv(saveFileName, csvTextStream)
	Next

	csvTextStream.Close()
	Set csvTextStream = Nothing
	Set oCsvFile = Nothing
End Sub

'************************************************************
'関数ID          ：GetMunicipalities
'説明            ：地方公共団体のXMLをローカルに保存する
'引数            ：prefcode … 都道府県コード
'引数            ：saveFileName … 保存ファイル名
'戻り値          ：実行結果 0:成功 -1:失敗
'************************************************************
Function GetMunicipalities(prefcode, saveFileName)
	Dim targetUrl

	GetMunicipalities = -1

	targetUrl = MUNICIPALITIES_URL & prefcode

	If SaveResponse(targetUrl, saveFileName) = 0 Then
		GetMunicipalities = 0
	End If
End Function

'************************************************************
'関数ID          ：ConvertMunicipalities2Csv
'説明            ：地方公共団体のXMLファイルをCSVファイルに保存
'引数            ：xmlFile … XMLファイル名
'引数            ：csvTextStream … CSVファイルの出力ストリーム
'戻り値          ：なし
'************************************************************
Sub ConvertMunicipalities2Csv(xmlFile, csvTextStream)
	Dim result
	Dim nodeRoot
	Dim nodeItems
	Dim nodeItem
	Dim code
	Dim name

	Dim lineData ' 書き込む行データ

	'非同期
	objXml.async=False
	' XMLファイルの読み込み
	result = objXml.Load(xmlFile)
	If Not result Then
		WScript.Echo objXml.parseError.errorCode
		WScript.Echo objXml.parseError.reason
		Exit Sub
	End If

	Set nodeRoot = objXml.documentElement
	' LocalGovermentタグのリストを取得
	Set nodeItems = nodeRoot.childNodes
	For Each nodeItem In nodeItems
		code = nodeItem.getAttribute("LocalGovCode")
		name = nodeItem.getElementsByTagName("LocalGovName").Item(0).Text

		lineData = code & "," & name
		csvTextStream.WriteLine(lineData)
	Next
End Sub

' ===========================================================
' 共通処理
' ===========================================================
'************************************************************
'関数ID          ：SaveResponse
'説明            ：指定されたURLの取得内容をファイルに保存する
'引数            ：url      … 取得先URL
'引数            ：filePath … ファイルパス
'戻り値          ：実行結果 0:成功 -1:失敗
'************************************************************
Function SaveResponse(url, filePath)
	Dim objAdodbStream    ' ADODB.Streamオブジェクト

	SaveResponse = -1

	' 既存のファイルを削除
	if g_objFSO.FileExists(filePath) Then
		g_objFSO.DeleteFile filePath
	End if

	' 同期処理
	g_objXMLHTTP.Open "GET", url, False
	g_objXMLHTTP.Send

	If g_objXMLHTTP.Status = 200 Then
		Set objAdodbStream = CreateObject("ADODB.Stream")
		objAdodbStream.Open
		objAdodbStream.Type = 1
		objAdodbStream.Write g_objXMLHTTP.responseBody
		objAdodbStream.SaveToFile filePath
		objAdodbStream.Close
		Set objAdodbStream = Nothing
		SaveResponse = 0
	Else
		WScript.Echo "Error returnCode:" & g_objXMLHTTP.Status
	End If
End Function

'************************************************************
'関数ID          ：ReadTextAll
'説明            ：テキストファイルの内容をすべて読み込みます
'引数            ：filePath ･･･ テキストファイルパス
'戻り値          ：ファイルの内容のテキスト
'************************************************************
Function ReadTextAll(filePath)
	Dim objTextStream  ' テキストストリームオブジェクト
	Dim resData        ' テキスト内容
	
	Set objTextStream = g_objFSO.OpenTextFile(filePath, 1)
	resData = objTextStream.ReadAll

	objTextStream.Close
	Set objTextStream = Nothing
	ReadTextAll = resData
End Function