金融機関コードの取得(VB Scripts)
職場のシステムで、金融機関データの更新を定期的に行っていました。先日も更新を行ってほしいとのことで、更新プログラムを動かしたらエラーになって取得できなかったので、サイトを家訓すると、閉鎖していましたorz….
改めて、データをどこかからダウンロードできないか、いろいろと調べたのですが、検索サイトはたくさんあったのですが、データをダウンロードできるところが１か所しか見つかりませんでした。
見つかったところは以下のサイトです
「快適生活＠IT力」 こちらの 「金融機関コードをCSV/エクセル形式で一覧にしてまとめたページ」のページにありました。
とりあえず、データをダウンロードして使用できるか確認すると、問題なく使用できそうなので、こちらを利用することにしました。
ただ、システムに取り込むにはデーターを加工しないとそのままでは使えないので、今でのプログラムの改変を行おうかなとも考えたのですが、Accessを使用していたのと、CSVの並び替えをするだけだしなっと思い、新しくプログラムを書くことにしました。
最初はBATで出来ないかなと思い、AIに相談するとBATで出来ないこともないが、VBSの方が楽だよってことで、VBSで作ることにしました。
以下にコードを載せておきます。解説は簡単にしておきます。ちなみに、全件版なので、差分については考慮していません。あしからず..
任意のファイル名で拡張子をvbsで保存した後、実行とすると同じフォルダに、ダウンロードしたものと、変換したものを保存できます。
ダウンロードしたファイルはUTF8形式ですが、変換後のファイルはSJIS形式で保存されます。
設定項目で出力ファイル名や.データの並び順を変えられます。詳しくは中のコメントを読んでいただけたらと思います。
Option Explicit
' ======================================================================
' 設定項目（ここを書き換えるだけで簡単に変更できます）
' ======================================================================
' 1. CSVが掲載されているダウンロードページのURL
Const PAGE_URL = "https://senrinomitiwohitoaside.com/bankdata/"
' 2. 並び替え加工した後のシステム用CSVファイル名
Const OUTPUT_FILE_NAME = "銀行支店.csv"
' 3. 出力ファイルにヘッダー（列名の行）を含めるかどうか（True = 付ける、False = 付けない）
Const HAS_HEADER = False
' 4. 出力するCSVのヘッダー（列名）※出力する列の数や内容に合わせて書き換えてください
Const OUTPUT_HEADER = "銀行コード,支店コード,銀行名（半角カナ）,銀行名,支店名（半角カナ）,支店名,フラグ,区分,空白列"
' 5. 出力したい列の順番・カスタム文字
' ・数字（0～7） ＝ 元データの列をそのまま出力
' ・"TEXT:文字" ＝ 固定の文字列を一律で出力
' ・"TEXT:" ＝ 空白の列（空欄）を出力
' 例：ARR_COL_ORDER = Array(5, 6, 2, 1, 4, 3, "TEXT:1", "TEXT:通常", "TEXT:")
Dim ARR_COL_ORDER
ARR_COL_ORDER = Array(5, 6, 2, 1, 4, 3)
' 6. ポップアップを自動で閉じる秒数（秒）
Const CLOSE_TIME = 3
' 7. ポップアップのスタイル定義（4096 = 常に最前面に表示）
Const STYLE_INFO = 4160 ' 常に最前面 ＋ 情報アイコン
Const STYLE_ERROR = 4112 ' 常に最前面 ＋ エラーアイコン
' ======================================================================
Dim scriptPath, outputPath
scriptPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
outputPath = scriptPath & OUTPUT_FILE_NAME
Dim shell
Set shell = CreateObject("WScript.Shell")
' 最初の確認メッセージ（設定した秒数で自動消滅・常に最前面）
shell.Popup "サイト上の最新ファイルを確認中...", CLOSE_TIME, "銀行マスタ更新", STYLE_INFO
' 2. ページのHTMLを取得
Dim http, html
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
http.Open "GET", PAGE_URL, False
http.Send
If http.Status <> 200 Then
shell.Popup "サイトへのアクセスに失敗しました。ステータス: " & http.Status, CLOSE_TIME, "エラー", STYLE_ERROR
WScript.Quit
End If
html = http.ResponseText
' 3. HTMLの中から最新のファイルリンクを取得
Dim csvUrl, idxBankData, idxStart, idxEnd
idxBankData = InStr(html, "bank_data-")
If idxBankData = 0 Then
shell.Popup "ページ内に「対象ファイル(bank_data-)」のが見つかりませんでした。", CLOSE_TIME, "エラー", STYLE_ERROR
WScript.Quit
End If
idxStart = InStrRev(html, "https://", idxBankData)
idxEnd = InStr(idxBankData, html, ".csv")
If idxStart = 0 Or idxEnd = 0 Or idxEnd < idxStart Then
shell.Popup "最新CSVのURL構造の解析に失敗しました。", CLOSE_TIME, "エラー", STYLE_ERROR
WScript.Quit
End If
csvUrl = Mid(html, idxStart, (idxEnd + 4) - idxStart)
' 4. 切り出したURLから最新のファイル名を特定
Dim originFileName, rawFilePath
originFileName = Mid(csvUrl, InStrRev(csvUrl, "/") + 1)
rawFilePath = scriptPath & originFileName
' 5. 【重複判定】すでに同じデータがあれば終了
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(rawFilePath) Then
shell.Popup "サーバー上の最新ファイル（" & originFileName & "）はすでに取得済みです。" & vbCrLf & "処理をスキップしました。", CLOSE_TIME, "完了", STYLE_INFO
Set http = Nothing
Set fso = Nothing
Set shell = Nothing
WScript.Quit
End If
' 6. 日付が違うファイルの場合のみ、ダウンロードしてローカルに保存
shell.Popup "最新ファイル（" & originFileName & "）を発見しました。" & vbCrLf & "ダウンロードを開始します...", CLOSE_TIME, "更新検知", STYLE_INFO
http.Open "GET", csvUrl, False
http.Send
If http.Status <> 200 Then
shell.Popup "CSVファイルのダウンロードに失敗しました。", CLOSE_TIME, "エラー", STYLE_ERROR
WScript.Quit
End If
Dim binaryStream
Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = 1
binaryStream.Open
binaryStream.Write http.ResponseBody
binaryStream.SaveToFile rawFilePath, 2
binaryStream.Close
Set binaryStream = Nothing
Set http = Nothing
' 7. 【文字コード対策】ダウンロードしたファイルを「UTF-8」として開く
Dim inputStream
Set inputStream = CreateObject("ADODB.Stream")
inputStream.Type = 2
inputStream.Charset = "UTF-8"
inputStream.Open
inputStream.LoadFromFile rawFilePath
' 8. 出力先（Shift-JIS）ファイルを新規作成
Dim outputFile
Set outputFile = fso.OpenTextFile(outputPath, 2, True, 0)
' 設定が True の場合のみヘッダーを書き出し
If HAS_HEADER Then
outputFile.WriteLine OUTPUT_HEADER
End If
Dim line, items, isHeader, outLine, i, colConf, val
isHeader = True
' 上から1行ずつループ処理
Do Until inputStream.EOS
line = inputStream.ReadText(-2)
If Trim(line) <> "" Then
If isHeader Then
isHeader = False ' ダウンロードした元ファイルのヘッダー行はスキップ
Else
items = Split(line, ",")
' 元データの列数が正常かチェック
If UBound(items) >= 7 Then
outLine = ""
' ARR_COL_ORDER に合わせて1列ずつ処理
For i = 0 To UBound(ARR_COL_ORDER)
colConf = ARR_COL_ORDER(i)
' "TEXT:" から始まっているかどうかを判定
If Left(CStr(colConf), 5) = "TEXT:" Then
' "TEXT:" の後ろにある文字列をそのまま使用
val = Mid(CStr(colConf), 6)
Else
' 数字の場合は、元データの該当する列から値を取得
val = items(CInt(colConf))
End If
' カンマで結合
If i = 0 Then
outLine = val
Else
outLine = outLine & "," & val
End If
Next
outputFile.WriteLine outLine
End If
End If
End If
Loop
' 後片付け
inputStream.Close
outputFile.Close
Set fso = Nothing
Set inputStream = Nothing
shell.Popup "最新データの更新と並び替えが完了しました！" & vbCrLf & vbCrLf & _
"ダウンロードファイル名: " & originFileName & vbCrLf & _
"出力CSVファイル名: " & OUTPUT_FILE_NAME, CLOSE_TIME, "成功", STYLE_INFO
Set shell = Nothing
もし、不具合等があれば、コメントを残していただけたら修正します。