じゃばのひまつぶし：ExcelVBAによる競馬ソフト自作教室とJRA-VAN登録ソフト（おずたんシリーズ）のサポートサイトです。

JRA-VAN Data Lab対応競馬ソフト自作教室

<New JVData Explorer> 基礎編：速報データ取得

第６回

更新日
2012-01-14

１．速報系データをダウンロードするプログラムを作ります。 ”Top”シートにコマンドボタンを追加し、名前(Caption)を”③速報系データ取得[0BXX]”とします。下図参照。この回で作成するプログラムではセル”D”列にデータを表示するため、今までに作成したボタンが”D”列にかかっている場合は、”D”列を避けるようにずらしてください。（注意：この回で作成するプログラムはこの回分をすべて作成するまで、できるだけ中断しないでください。やむをえず中断して終了する場合は、上書き保存で保存後Excelを終了してください。再起動時は、この回のプログラムを完了するまで、＜速報系データ取得[0BXX]＞ボタンをクリックしないでください）
速報系データを取得する順番は下図のようにしています。（この順番でなければいけないというものではありません）
①コントロールツールボックスをデザインモード・オンにして、”③速報系データ取得[0BXX]”ボタンをダブルくクリックして、[CommandButton4]に下記コードを記述します（”Top”シート）。速報系データを上図の順番にダウンロードします。 '*************** 速報系データダウンロード(Top) ************** '[第６回] Private Sub CommandButton4_Click() Dim NENGAPPI As String Range("O5").Value = "速報系データダウンロード中" DoEvents '* 開催日データを取得 NENGAPPI = ComboBox1.Text Call 速報データ取得(NENGAPPI) End Sub
②上記のプログラムで使う[速報データ取得]サブルーチンを作ります。 ”mMod2”モジュールに追加記述します。"OBXX"タイプの速報データを順番にダウンロードします。このプログラムは総合的なプログラムで、順次この後で作る個々の[0BXX]データ取得プログラムを呼び出すものです。最初の部分の「条件設定およびクリア」部分では、JV-Linkの設定やすでに書き込まれているシートの領域を消去します。「個別データの取得と表示」以下で順次別のプログラムを呼び出して実行します。 '*************** 速報データを取得(mMod2) ************** '[第６回] Sub 速報データ取得(ByVal NENGAPPI As String) Dim key As String '=========条件設定およびクリア=========== Call Set_JVLink_For_Worksheet Call JVLink1.JVClose Call GetDirectoryData '* ワークシート上のデータを消去 dataspec = "0BXX" Call WorksheetFileListClear(dataspec) '* 場所名をクリア Call BashoClear '* キーを設定 key = "20" & NENGAPPI '========== 個別データの取得と表示 ========== '* 速報開催情報の取得 dataspec = "0B12" 'データ仕様：ゼロ・ビー12 Call DownloadJVRT_0B12(dataspec, key) ' 馬体重情報の取得 dataspec = "0B11" 'データ仕様：ゼロ・ビー11 Call DownloadJVRT_0B11(dataspec, key) ' 開催変更情報の取得 dataspec = "0B14" 'データ仕様：ゼロ・ビー14 Call DownloadJVRT_0B14(dataspec, key) ' データマイニング予想値の取得 dataspec = "0B13" 'データ仕様：ゼロ・ビー13 Call DownloadJVRT_0B13(dataspec, key) ' 速報系オッズ取得 dataspec = "0B30" 'データ仕様：ゼロ・ビー30 Call DownloadJVRT_0B30(dataspec, key) ' 時系列単複枠オッズの取得 dataspec = "0B41" 'データ仕様：ゼロ・ビー41 Call DownloadJVRT_0B4142(dataspec, key) ' 時系列馬連オッズの取得 dataspec = "0B42" '*データ仕様：ゼロ・ビー42 Call DownloadJVRT_0B4142(dataspec, key) End Sub
③さらに下記のサブルーチンを記述します。[DownloadJVRT_0B14] これらは上記のサブルーチンの中の各データをダウンロードするプログラムです。”mMod2”モジュールに追加記述します。ダウンロード順とはサブルーチンの記述順番が違いますが、理解と作りやすいように処理方法に共通性のあるサブルーチンを並べています。まずは”速報開催変更情報(0B14)”ダウンロード用のコードです。変更”データ種別ID”(dataspec)と開催年月日(key)をパラメータにして呼び出します。これは開催情報の発走時刻や競走馬取り消し、騎手変更などがあった場合に前日～開催日に提供されるデータ取得用のため、変更がない場合は、使用されません。 '****************** 速報開催変更情報(0B14)を取得(mMod2) *********************** '* 速報開催変更情報は数種類のデータの合同のため配列処理が複雑 '[第６回] Private Sub DownloadJVRT_0B14(ByVal dataspec As String, ByVal key As String) Dim retVal As Long Dim p As Long, q As Long Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long, p5 As Long Dim buf As String, filename As String Dim ID As String Dim NENGAPPI As String Dim FN As Integer Dim Cnt1 As Long, Cnt2 As Long, Cnt3 As Long, Cnt4 As Long, Cnt5 As Long Dim SokuhoData As String If dataspec <> "0B14" Then Exit Sub 'データ種別が[0B14]以外なら終了 NENGAPPI = Mid$(key, 3, 6) SokuhoData = "" '速報データを連結する文字列をリセット p1 = 0: p2 = 0: p3 = 0: p4 = 0: p5 = 0 'データカウントの初期値を設定 Cnt1 = 1: Cnt2 = 1: Cnt3 = 1: Cnt4 = 1: Cnt5 = 1 '配列カウンタの初期値を設定 '* JVRTOpenでダウンロード retVal = JVLink1.JVRTOpen(dataspec, key) Sleep (100) '* エラー発生の場合は終了 If retVal < 0 Then If retVal = -1 Then Worksheets("Top").Range("O5").Value = "[0B14] 速報開催変更情報該当データなし" Else MsgBox "JVRTOpenでエラー(" & retVal & ") が発生しました。" End If Call JVLink1.JVClose Exit Sub End If '* 正常にダウンロード終了の場合は解析 ReDim myStr(4) As String '５種類の文字列配列を定義(0～4) '各配列の初期分を定義 ReDim WeData(1 To Cnt1) As String '天候・馬場情報用 ReDim AvData(1 To Cnt2) As String '取消・除外情報用 ReDim JcData(1 To Cnt3) As String '騎手変更情報用 ReDim CcData(1 To Cnt4) As String 'コース変更情報用 ReDim TcData(1 To Cnt5) As String '発走時刻変更情報用 retVal = 1 While retVal <> 0 '* キャッシュのJVDataを読み込む retVal = JVLink1.JVRead(buf, 200000, filename) If retVal > 0 Then '* バッファ内容を読み取る GoSub ReadBufferData '* データ区切りでセーブ ElseIf retVal = -1 Then Range("O5").Value = "[" & NENGAPPI & "] 開催変更情報セーブ中" DoEvents '* データを統合（"#"記号を挟んで連結） SokuhoData = Join(myStr, "#") '保存用ファイルを設定して保存 CopyFile$ = COPY_DIR & "\" & NENGAPPI & "\" & Left$(filename, Len(filename) - 4) & ".dat" FN = FreeFile Open CopyFile$ For Output As #FN Print #FN, SokuhoData Close #FN '* ワークシートにファイル情報を表示 GoSub DisplayFileInfo End If DoEvents Wend Call JVLink1.JVClose Range("O5").Value = "[" & NENGAPPI & "] 開催変更情報　取得完了" DoEvents Exit Sub '----------------------------------------------------------- ' サブルーチン '----------------------------------------------------------- ' バッファ内容を読み取る ReadBufferData: '* データ種別IDを設定 ID = Left$(buf, 2) Select Case ID '* 天候・馬場状態 Case "WE" p1 = p1 + 1 'データカウントアップ If p1 > Cnt1 Then Cnt1 = Cnt1 + 1 '初期値以上のデータがあれば配列を拡張 ReDim Preserve WeData(1 To Cnt1) As String End If WeDataSu = Cnt1 '総データ数を代入 WeData(p1) = Left$(buf, Len(buf) - 2) 'データを配列に代入 Range("O5").Value = "[" & NENGAPPI & "] 天候情報= " & p1 DoEvents '* データを連結("#"記号を挟んでデータが連結して追加されていく） If p1 = 1 Then myStr(0) = WeData(p1) Else myStr(0) = myStr(0) & "#" & WeData(p1) End If '* 取消・除外 Case "AV" p2 = p2 + 1 'データカウントアップ If p2 > Cnt2 Then Cnt2 = Cnt2 + 1 '初期値以上のデータがあれば配列を拡張 ReDim Preserve AvData(1 To Cnt2) As String End If AvDataSu = Cnt2 '総データ数を代入 AvData(p2) = Left$(buf, Len(buf) - 2) 'データを配列に代入 Range("O5").Value = "[" & NENGAPPI & "] 取消・除外情報= " & p2 DoEvents '* データを連結("#"記号を挟んでデータが連結して追加されていく） If p2 = 1 Then myStr(1) = AvData(p2) Else myStr(1) = myStr(1) & "#" & AvData(p2) End If '* 騎手変更 Case "JC" p3 = p3 + 1 'データカウントアップ If p3 > Cnt3 Then Cnt3 = Cnt3 + 1 '初期値以上のデータがあれば配列を拡張 ReDim Preserve JcData(1 To Cnt3) As String End If JcDataSu = Cnt3 '総データ数を代入 JcData(p3) = Left$(buf, Len(buf) - 2) 'データを配列に代入 Range("O5").Value = "[" & NENGAPPI & "] 騎手変更= " & p3 DoEvents '* データを連結("#"記号を挟んでデータが連結して追加されていく） If p3 = 1 Then myStr(2) = JcData(p3) Else myStr(2) = myStr(2) & "#" & JcData(p3) End If '* コース変更 Case "CC" p4 = p4 + 1 'データカウントアップ If p4 > Cnt4 Then Cnt4 = Cnt4 + 1 '初期値以上のデータがあれば配列を拡張 ReDim Preserve CcData(1 To Cnt4) As String End If CcDataSu = Cnt4 '総データ数を代入 CcData(p4) = Left$(buf, Len(buf) - 2) 'データを配列に代入 Range("O5").Value = "[" & NENGAPPI & "] コース変更= " & p4 DoEvents '* データを連結("#"記号を挟んでデータが連結して追加されていく） If p4 = 1 Then myStr(3) = CcData(p4) Else myStr(3) = myStr(3) & "#" & CcData(p4) End If '* 発走時刻変更 Case "TC" p5 = p5 + 1 'データカウントアップ If p5 > Cnt5 Then Cnt5 = Cnt5 + 1 '初期値以上のデータがあれば配列を拡張 ReDim Preserve TcData(1 To Cnt5) As String End If TcDataSu = Cnt5 '総データ数を代入 TcData(p5) = Left$(buf, Len(buf) - 2) 'データを配列に代入 Range("O5").Value = "[" & NENGAPPI & "] 発走時刻変更= " & p5 DoEvents '* データを連結("#"記号を挟んでデータが連結して追加されていく） If p5 = 1 Then myStr(4) = TcData(p5) Else myStr(4) = myStr(4) & "#" & TcData(p5) End If End Select Return '* --------------------------------------------------------- '* ワークシートにファイル情報を表示 DisplayFileInfo: With Worksheets("Top") q = .Range("O9").Value '初期値 '* ファイル情報 .Range("N" & 11 + q).Value = dataspec '* ファイル名 .Range("O" & 11 + q).Value = Left(filename, Len(filename) - 4) & ".dat" '* 開催年月日 .Range("P" & 11 + q).Value = "'" & NENGAPPI '* データ区分 .Range("Q" & 11 + q).Value = "" '* データ数(0B14は混成のためファイル数を決めにくい） .Range("R" & 11 + q).Value = "" .Range("O9").Value = q + 1 'カウントアップした値を表示 End With Return End Sub
速報開催変更情報(0B14)のダウンロードフローチャートは下図のイメージです。
プログラムのポイント速報開催情報(0B14)には、５つのデータが混在します。天候・馬場状態(WE)、コース変更(CC)、発走時刻変更(TC)、取消・除外(AV)、騎手変更(JC)。騎手変更や取消・除外など何もない場合には提供されないデータもあります。騎手変更などは、未定のままや次の騎手が決まるレースごとに何回も提供されるものもあります。これらの混在するデータをレコード種別ID別に文字列として連結し、さらに全体を１つの文字列に連結（"#"記号を挟んで連結）してセーブするのがポイントです（後で読み込む際にまた分割します）。変更情報で扱うデータは５種類ですが、基本的な扱い方法は同じです。（１）まず配列が１個の初期配列を用意し、データがあればそこに代入する。（２）さらに変更情報があれば配列を拡張して、配列データを代入する。（データは順次ワークシートに表示する）（３）最初のデータと次のデータを”＃”記号で連結する文字列を作る。（４）全データが終わるまで、（２）（３）を行い、最後の連結データを保存する。連結したデータを後で利用する場合は、”＃”記号を手掛かりにして分割して元の配列を作ります。（注意：”＃”記号がJVDataに使われていないことを前提にしているので、もし”＃”が使われている場合は、正しくデータを認識することができない恐れがあります。今のところはOKのようですが・・・）
④次のサブルーチンは速報レース情報(0B12)をダウンロードするプログラムです。[DownloadJVRT_0B12] ”mMod2”モジュールに記述します。 "0B12"はレース結果の着順や払戻情報が含まれるデータで、レース確定後に何段階かの”データ区分”で提供されます。たとえば３着までの着順と払戻だけの情報や、最後には全着順やコーナー順位までの確定段階まで。３つのレコード種別（RA/SE/HR)に分けて取得します。 '****************　レース結果(0B12)速報系データのダウンロード(mMod2)　****************** '[第６回] Private Sub DownloadJVRT_0B12(ByVal dataspec As String, ByVal key As String) Dim retVal As Long Dim p As Long, q As Long, pp As Long Dim p1 As Long, p2 As Long, p3 As Long Dim buf As String, filename As String Dim ID As String Dim NENGAPPI As String Dim FN As Integer Dim Cnt1 As Long, Cnt2 As Long, Cnt3 As Long Dim SokuhoData As String If dataspec <> "0B12" Then Exit Sub '0B12以外のデータの場合は終了 '速報・払戻情報 NENGAPPI = Mid$(key, 3, 6) SokuhoData = "" p1 = 0: p2 = 0: p3 = 0 Cnt1 = 1: Cnt2 = 1: Cnt3 = 1 ' JVRTOpenでダウンロード retVal = JVLink1.JVRTOpen(dataspec, key) Sleep (100) '* エラー発生の場合 If retVal < 0 Then If retVal = -1 Then Worksheets("Top").Range("O5").Value = "[0B12] 速報レース情報該当データなし" Else MsgBox "JVRTOpenでエラー(" & retVal & ") が発生しました。" End If Call JVLink1.JVClose Exit Sub End If '* 正常にダウンロード終了の場合 '仮配列定義(積み上げ型) ReDim myStr(2) As String ReDim RaData(1 To Cnt1) As String ReDim SeData(1 To Cnt2) As String ReDim HrData(1 To Cnt3) As String retVal = 1 While retVal <> 0 ' キャッシュのデータを読み込む retVal = JVLink1.JVRead(buf, 200000, filename) 'データ読み込み If retVal > 0 Then ' バッファ内容を読み取る GoSub ReadBufferData '変更情報のセーブ ElseIf retVal = -1 Then Range("O5").Value = "[" & NENGAPPI & "] レース結果速報セーブ中" DoEvents ' データを連結 SokuhoData = Join(myStr, "#") CopyFile$ = COPY_DIR & "\" & NENGAPPI & "\" & Left$(filename, Len(filename) - 4) & ".dat" FN = FreeFile Open CopyFile$ For Output As #FN Print #FN, SokuhoData Close #FN '* ワークシートにファイル情報を表示 GoSub DisplayFileInfo End If Wend Call JVLink1.JVClose Range("O5").Value = "[" & NENGAPPI & "] レース速報　取得完了" DoEvents Exit Sub '------------------------------------------------------------- ' サブルーチン '------------------------------------------------------------- ' バッファ内容を読み取る ReadBufferData: '* レコード種別ID ID = Left$(buf, 2) Select Case ID '* レース詳細 Case "RA" p1 = p1 + 1 If p1 > Cnt1 Then Cnt1 = Cnt1 + 1 ReDim Preserve RaData(1 To Cnt1) As String End If RaDataSu = Cnt1 RaData(p1) = Left$(buf, Len(buf) - 2) Range("O5").Value = "[" & NENGAPPI & "] レース結果速報・レース詳細= " & p1 DoEvents '* データを連結 If p1 = 1 Then myStr(0) = RaData(p1) Else myStr(0) = myStr(0) & "#" & RaData(p1) End If '* 馬毎レース情報 Case "SE" p2 = p2 + 1 If p2 > Cnt2 Then Cnt2 = Cnt2 + 1 ReDim Preserve SeData(1 To Cnt2) As String End If SeDataSu = Cnt2 SeData(p2) = Left$(buf, Len(buf) - 2) Range("O5").Value = "[" & NENGAPPI & "] レース結果速報・競走馬情報= " & p2 DoEvents '* データを連結 If p2 = 1 Then myStr(1) = SeData(p2) Else myStr(1) = myStr(1) & "#" & SeData(p2) End If '* 払戻情報 Case "HR" p3 = p3 + 1 If p3 > Cnt3 Then Cnt3 = Cnt3 + 1 ReDim Preserve HrData(1 To Cnt3) As String End If HrDataSu = Cnt3 HrData(p3) = Left$(buf, Len(buf) - 2) Range("O5").Value = "[" & NENGAPPI & "] レース結果速報・払戻情報= " & p3 DoEvents '* データを連結 If p3 = 1 Then myStr(2) = HrData(p3) Else myStr(2) = myStr(2) & "#" & HrData(p3) End If End Select Return '* --------------------------------------------------------- '* ワークシートにファイル情報を表示 DisplayFileInfo: With Worksheets("Top") q = .Range("O9").Value '* ファイル情報 .Range("N" & 11 + q).Value = dataspec '* ファイル名 .Range("O" & 11 + q).Value = Left(filename, Len(filename) - 4) & ".dat" '* 開催年月日 .Range("P" & 11 + q).Value = "'" & NENGAPPI '* データ区分 .Range("Q" & 11 + q).Value = "" '* データ数 .Range("R" & 11 + q).Value = "" .Range("O9").Value = q + 1 End With Return End Sub
プログラムのポイントレース結果情報は、開催場所により結果の判明する時間が異なります。このため速報データとしては最初は少ないデータ、レースが進むにつれてデータが増加します。並び方も場所別ではありません（最終的には場所別になる）。この不定期な並び方を文字列データの連結で処理するところがポイントです。速報レース情報(0B12)のフローチャートは前の(0B14)と同じです。扱うレコード種別が３つだけの違いです。
⑤次のサブルーチンは”データマイニング予想値(0B13)”をダウンロードするものです。”mMod2”モジュールに記述します。 [DownloadJVRT_0B13] '****************　データマイニング(0B13)速報系データのダウンロード(mMod2)　****************** '[第６回] Private Sub DownloadJVRT_0B13(ByVal dataspec As String, ByVal key As String) Dim retVal As Long Dim p As Long, q As Long Dim buf As String, filename As String Dim ID As String Dim NENGAPPI As String Dim FN As Integer p = 0 DataCnt = 1 DmDataSu = 0 If dataspec <> "0B13" Then Exit Sub 'DM速報データ NENGAPPI = Mid$(key, 3, 6) ' JVRTOpenでダウンロード retVal = JVLink1.JVRTOpen(dataspec, key) Sleep (100) '* エラー発生の場合 If retVal < 0 Then If retVal = -1 Then Worksheets("Top").Range("O5").Value = "[0B13] 速報開催情報該当データなし" Else MsgBox "JVRTOpenでエラー(" & retVal & ") が発生しました。" End If Call JVLink1.JVClose Exit Sub End If '* 正常にダウンロード終了の場合 '仮配列定義 ReDim DmData(1 To DataCnt) As String retVal = 1 While retVal <> 0 ' キャッシュの内容を読み込む retVal = JVLink1.JVRead(buf, 200000, filename) 'データ読み込み If retVal > 0 Then ' バッファ内容を読み取る GoSub ReadBufferData 'DM情報のセーブ ElseIf retVal = -1 Then Range("O5").Value = "[" & NENGAPPI & "] データマイニングセーブ中" DoEvents CopyFile$ = COPY_DIR & "\" & NENGAPPI & "\" & Left$(filename, Len(filename) - 4) & ".dat" FN = FreeFile Open CopyFile$ For Output As #FN For p = 1 To DmDataSu Print #FN, DmData(p) Next p Close #FN ' ワークシートにファイル情報を表示 GoSub DisplayFileInfo End If Wend Call JVLink1.JVClose Range("O5").Value = "[" & NENGAPPI & "] データマイニング　取得完了" DoEvents Exit Sub '------------------------------------------------------------- ' サブルーチン '------------------------------------------------------------- ' バッファ内容を読み取る ReadBufferData: ID = Left$(buf, 2) Select Case ID '* データマイニング Case "DM" p = p + 1 If p > DataCnt Then DataCnt = DataCnt + 1 ReDim Preserve DmData(1 To DataCnt) As String End If DmDataSu = DataCnt DmData(p) = Left$(buf, Len(buf) - 2) End Select Return '* --------------------------------------------------------- '* ワークシートにファイル情報を表示 DisplayFileInfo: With Worksheets("Top") q = .Range("O9").Value '* ファイル情報 .Range("N" & 11 + q).Value = dataspec '* ファイル名 .Range("O" & 11 + q).Value = Left(filename, Len(filename) - 4) & ".dat" '* 開催年月日 .Range("P" & 11 + q).Value = "'" & NENGAPPI '* データ区分 .Range("Q" & 11 + q).Value = "" '* データ数 .Range("R" & 11 + q).Value = DmDataSu .Range("O9").Value = q + 1 End With Return End Sub
プログラムのポイントこのデータは”データマイニング”という１種類のみのデータを扱うので、前２つのサブルーチンほど処理が複雑ではありません。特に難しいコードはありません。ただデータマイニングデータは前日、オッズ発表、馬体重発表後など２～３段階でデータが提供されます。
”データマイニング情報(0B13)”のダウンロードのフローチャートは下図のイメージです。基本的には前のものと同じですが、データが１種類のため、定義した配列にデータを代入し、セーブも配列で行います。（連結形式ではありません）”0B13”データは、開催日１日単位で提供されるため、配列１つが１レース分のデータになります。
⑥次のサブルーチンは”馬体重情報(0B11)”をダウンロードするものです。”mMod2”モジュールに記述します。 [DownloadJVRT_0B11] '****************　馬体重情報(0B11)速報系データのダウンロード(mMod2)　****************** '[第６回] Private Sub DownloadJVRT_0B11(ByVal dataspec As String, ByVal key As String) Dim retVal As Long Dim p As Long, q As Long Dim buf As String, filename As String Dim ID As String Dim NENGAPPI As String Dim FN As Integer Dim Cnt As Long If dataspec <> "0B11" Then Exit Sub p = 0 Cnt = 1 '馬体重情報 NENGAPPI = Mid$(key, 3, 6) ' JVRTOpenでダウンロード retVal = JVLink1.JVRTOpen(dataspec, key) Sleep (100) '* エラー発生の場合 If retVal < 0 Then If retVal = -1 Then Worksheets("Top").Range("O5").Value = "[0B11] 速報馬体重情報該当データなし" Else MsgBox "JVRTOpenでエラー(" & retVal & ") が発生しました。" End If Call JVLink1.JVClose Exit Sub End If '* 正常にダウンロード終了の場合 '仮配列定義(積み上げ型) ReDim WhData(1 To Cnt) As String retVal = 1 While retVal <> 0 ' キャッシュの内容を読み込む retVal = JVLink1.JVRead(buf, 200000, filename) 'データ読み込み If retVal > 0 Then ' バッファ内容を読み取る GoSub ReadBufferData '馬体重情報のセーブ ElseIf retVal = -1 Then Range("O5").Value = "[" & NENGAPPI & "] 馬体重情報セーブ中" DoEvents CopyFile$ = COPY_DIR & "\" & NENGAPPI & "\" & Left$(filename, Len(filename) - 4) & ".dat" FN = FreeFile Open CopyFile$ For Output As #FN For p = 1 To WhDataSu Print #FN, WhData(p) Next p Close #FN ' ワークシートにファイル情報を表示 GoSub DisplayFileInfo End If Wend Call JVLink1.JVClose Range("O5").Value = "[" & NENGAPPI & "] 馬体重情報　取得完了" DoEvents Exit Sub '---------------------------------------------------------------- ' サブルーチン '---------------------------------------------------------------- ' バッファ内容を読み取る ReadBufferData: '* レコード種別ID ID = Left$(buf, 2) Select Case ID '* 馬体重 Case "WH" p = p + 1 If p > Cnt Then Cnt = Cnt + 1 ReDim Preserve WhData(1 To Cnt) As String End If WhDataSu = Cnt WhData(p) = Left$(buf, Len(buf) - 2) End Select Return '* --------------------------------------------------------- '* ワークシートにファイル情報を表示 DisplayFileInfo: With Worksheets("Top") q = .Range("O9").Value '* ファイル情報 .Range("N" & 11 + q).Value = dataspec '* ファイル名 .Range("O" & 11 + q).Value = Left(filename, Len(filename) - 4) & ".dat" '* 開催年月日 .Range("P" & 11 + q).Value = "'" & NENGAPPI '* データ区分 .Range("Q" & 11 + q).Value = "" '* データ数 .Range("R" & 11 + q).Value = WhDataSu .Range("O9").Value = q + 1 End With Return End Sub プログラムのポイントこのサブルーチンも前のプログラムと同じく単一のデータ（馬体重）を扱うので処理方法も似ています。馬体重情報はレースの1時間位前に発表されるので、その都度提供されます。ダウンロードのフローチャートも前の”データマイニング(0B13)”と同じです。
⑦次のサブルーチンは”速報オッズ(0B30)”をダウンロードするものです。[DownloadJVRT_0B30] このデータの扱いは若干ややこしいです。フローチャートは下図のイメージです。中央競馬では全国１０か所の競馬場があり、その中で２～３の場所で競馬が開催され、それぞれが最大で１２レースあります。このサブルーチン（マクロ）では、競馬場を１番目（札幌）とレース数を１レースから想定してデータを取得するキーを設定して、該当するデータの有無をチェックしていきます。該当するデータがあればダウンロードします。
コードは”mMod2”モジュールに記述します。 '****************　速報オッズ(0B30)速報系データのダウンロード(mMod2)　****************** '* 0B30は"O1","O2","O3","O4","O5","O6"の６種類のオッズが１つのレコードに統合。 '* 頭数により"O1"(単複枠)の枠連がなかったり、"O6"(三連単)がないレースもありうる。 '* 各レース単位にセーブするので、セーブ時点ではレコードを配列にする必要なし。 '[第６回] Private Sub DownloadJVRT_0B30(ByVal dataspec As String, ByVal key As String) Dim retVal As Long Dim p As Long, q As Long, pp As Long Dim DaySet As String '開催日情報：YYYYMMDDJJRR Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long, p5 As Long, p6 As Long Dim buf As String, filename As String Dim ID As String Dim NENGAPPI As String Dim FN As Integer Dim DWLD As Long Dim Basho As String Dim SokuhoData As String DWLD = 0 p1 = 0 DataCnt = 1 If dataspec <> "0B30" Then Exit Sub NENGAPPI = Mid$(key, 3, 6) ' 速報オッズは場所毎・レース毎にチェックする For p = 1 To 10 '* 場所数ループ(10場所分) For pp = 1 To 12 '* レース数ループ（12レース分） DownloadRetry: '* DaySet="YYYYMMDDJJRR" DaySet = key & Format(p, "00") & Format(pp, "00") 'キーを設定 SokuhoData = "" DWLD = 0 'ダウンロードトライ回数リセット '* JVRTOpenでダウンロード retVal = JVLink1.JVRTOpen(dataspec, DaySet) Sleep (100) '* 正常にダウンロードできた場合 If retVal = 0 Then '仮配列定義 ReDim myStr(5) As String retVal = 1 While retVal <> 0 ' キャッシュの内容を読み込む retVal = JVLink1.JVRead(buf, 200000, filename) 'データ読み込み If retVal > 0 Then '場所コードを場所名に変換 Basho = KeibajoName(Format(p, "00")) Worksheets("Top").Range("O5").Value = "[" & NENGAPPI & "] " & Basho & _ " " & Format(pp, "00") & "R 速報オッズ取得中" ' 競馬場を記入（特別表示） GoSub BashoHyouji DoEvents '* バッファ内容を読み取る GoSub ReadBufferData 'オッズデータのセーブ ElseIf retVal = -1 Then Worksheets("Top").Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Mid$(filename, 13, 2)) & _ " " & Mid$(filename, 15, 2) & "R 速報オッズセーブ中" DoEvents 'オッズデータを結合（文字列の結合関数：かんプロコントロール・関数編p266） '空文字列も含む SokuhoData = Join(myStr, "#") CopyFile$ = COPY_DIR & "\" & NENGAPPI & "\" & Left$(filename, Len(filename) - 4) & ".dat" FN = FreeFile Open CopyFile$ For Output As #FN Print #FN, SokuhoData Close #FN ' ワークシートにファイル情報を表示 GoSub DisplayFileInfo GoTo NextRace End If DoEvents Wend 'データがない場合は次の競馬場・レースへ ElseIf retVal = -1 Then If pp = 1 Then Call JVLink1.JVClose Exit For End If ElseIf retVal < -1 Then 'エラー Worksheets("Top").Range("O5").Value = KeibajoName(Format(p, "00")) & _ " " & Format(pp, "00") & "R 速報オッズ JVRTOpenエラー(" & retVal & ") が発生。" DoEvents Call JVLink1.JVClose '* サーバーエラーなら再実行 If retVal < -401 And retVal > -500 Then '* 再度ダウンロード実行(計３回まで) Debug.Print "速報オッズエラー：" & KeibajoName(Format(p, "00")) & " " & Format(pp, "00") & "R" '* ３回までリトライ If DWLD < 3 Then DWLD = DWLD + 1 GoTo DownloadRetry Else '* ３回以上ならダウンロード失敗 MsgBox "速報オッズ[0B30]のダウンロードができませんでした。" Exit Sub End If Else Exit Sub End If End If NextRace: Call JVLink1.JVClose Next pp Call JVLink1.JVClose Next p Call JVLink1.JVClose Worksheets("Top").Range("O5").Value = "[" & NENGAPPI & "] 速報オッズ　取得完了" DoEvents Exit Sub '----------------------------------------------------------------- ' サブルーチン '----------------------------------------------------------------- ' バッファ内容を読み取る ReadBufferData: '速報オッズ解析 ID = Left$(buf, 2) Select Case ID '単複枠オッズ読み込み Case "O1" myStr(0) = Left$(buf, Len(buf) - 2) '馬連オッズ読み込み Case "O2" myStr(1) = Left$(buf, Len(buf) - 2) 'ワイドオッズ読み込み Case "O3" myStr(2) = Left$(buf, Len(buf) - 2) '馬単オッズ読み込み Case "O4" myStr(3) = Left$(buf, Len(buf) - 2) '三連複オッズ読み込み Case "O5" myStr(4) = Left$(buf, Len(buf) - 2) '三連単オッズ読み込み(他より少ない) Case "O6" myStr(5) = Left$(buf, Len(buf) - 2) End Select Return ' --------------------------------------------------------- '* ワークシートにファイル情報を表示 DisplayFileInfo: With Worksheets("Top") q = .Range("O9").Value '* ファイル情報 .Range("N" & 11 + q).Value = dataspec '* ファイル名 .Range("O" & 11 + q).Value = Left(filename, Len(filename) - 4) & ".dat" '* 開催年月日 .Range("P" & 11 + q).Value = "'" & NENGAPPI '* データ区分 .Range("Q" & 11 + q).Value = "" '* データ数 .Range("R" & 11 + q).Value = "" .Range("O9").Value = q + 1 End With Return '---------------------------------------------------------------- ' 競馬場を記入（特別表示）空いているセルに場所名を表示 BashoHyouji: With Worksheets("Top") If .Range("E2").Value = "" Then .Range("E2").Value = Basho Else If .Range("E2").Value = Basho Then Return Else If .Range("E3").Value = "" Then .Range("E3").Value = Basho Else If .Range("E3").Value = Basho Then Return Else If .Range("E4").Value = "" Then .Range("E4").Value = Basho Else If .Range("E4").Value = Basho Then Return End If End If End If End If End If End If End With Return End Sub プログラムのポイントこのデータも６つの種類のオッズを１つにまとめているので、各データを連結してセーブします。また今までのサブルーチンのように開催日単位でダウンロードするのではなく、レース単位で取得するので、処理が少しややこしくなります。また、サーバーエラー（タイムアウト）によりダウンロードに失敗することもあります。サーバーエラーが起こったときに同じレース分を３回リトライするようにしたのがポイントです。（注意：このマクロの中で、競馬場コード（０１～１０）を名前（札幌～小倉）に変換する関数マクロを使っていますが、それは後で作成します。）
⑧次は”時系列オッズ(0B41/0B42)”をダウンロードするものです。[DownloadJVRT_0B4142] ダウンロードのフローチャートは下図のイメージです。
コードは”mMod2”モジュールに記述します。時系列オッズは単複枠(0B41)と馬連(0B42)の2種類ありますが、共通のサブルーチンです。 '************　時系列オッズ(単複枠0B41・馬連0B42)速報系データのダウンロード(mMod2)　************** '[第６回] Private Sub DownloadJVRT_0B4142(ByVal dataspec As String, ByVal key As String) Dim retVal As Long Dim p As Long, q As Long, pp As Long, qq As Long Dim DaySet As String '開催日情報：YYYYMMDDJJRR Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long, p5 As Long Dim buf As String, filename As String Dim ID As String Dim NENGAPPI As String Dim FN As Integer Dim Basho As String Dim flgBasho As Boolean Dim DWLD As Long NENGAPPI = Mid$(key, 3, 6) Call JVLink1.JVClose ' 速報オッズは場所毎・レース毎にチェックする For p = 1 To 10 '* 場所数ループ For pp = 1 To 12 '* レース数ループ DWLD = 0 DownloadRetry: '時系列オッズ（単複枠）keyはKAISAIJOHO 'DaySet="YYYYMMDDJJRR" DaySet = key & Format(p, "00") & Format(pp, "00") p1 = 0: p2 = 0: p3 = 0: p4 = 0: p5 = 0 DataCnt = 1 ReDim DmyData(1 To DataCnt) As String '時系列オッズ配列 'JVRTOpenでダウンロード retVal = JVLink1.JVRTOpen(dataspec, DaySet) Sleep (100) ' 正常にダウンロードできた場合 If retVal = 0 Then retVal = 1 While retVal <> 0 '* キャッシュの内容を読み込む retVal = JVLink1.JVRead(buf, 200000, filename) 'データ読み込み If retVal > 0 Then ' バッファ内容を読み取る GoSub ReadBufferData 'オッズデータのセーブ ElseIf retVal = -1 Then ' 時系列オッズのセーブ GoSub TimeChangeOddsSave '* ワークシートにファイル情報を表示 GoSub DisplayFileInfo GoTo NextRace End If Wend 'データがない場合は次の競馬場・レースへ ElseIf retVal = -1 Then ' 最初のレース番号で判断 If pp = 1 Then '* 競馬場名が一致したらフラグをセット flgBasho = False For qq = 1 To 3 If Worksheets("Top").Range("D" & 1 + qq).Value = KeibajoName(Format(p, "00")) Then flgBasho = True Exit For End If Next qq '* 競馬場名が一致しなければパス If flgBasho = False Then Call JVLink1.JVClose Exit For '* 競馬場名が一致したらデータ取得に失敗と判断 ElseIf flgBasho = True Then '* 再度ダウンロード実行(計３回まで) Debug.Print "速報オッズエラー：" & KeibajoName(Format(p, "00")) & " " & Format(pp, "00") & "R" If DWLD < 3 Then DWLD = DWLD + 1 GoTo DownloadRetry Else '* 時系列ダウンロード失敗 GoSub DownloadFailed Exit For End If End If '* 2番目のレース以降ならデータ取得に失敗と判断 Else '* 再度ダウンロード実行(計３回まで) Debug.Print "速報オッズエラー：" & KeibajoName(Format(p, "00")) & " " & Format(pp, "00") & "R" If DWLD < 3 Then DWLD = DWLD + 1 GoTo DownloadRetry Else '* 時系列ダウンロード失敗 GoSub DownloadFailed Exit For End If End If 'retVal=-1以外のエラーの場合 ElseIf retVal < -1 Then Worksheets("Top").Range("O5").Value = KeibajoName(Format(p, "00")) & _ " " & Format(pp, "00") & "R 速報オッズ JVRTOpenエラー(" & retVal & ") が発生。" DoEvents Call JVLink1.JVClose ' サーバーエラーなら再実行 If retVal < -401 And retVal > -500 Then '* 再度ダウンロード実行(計３回まで) Debug.Print "速報オッズエラー：" & KeibajoName(Format(p, "00")) & " " & Format(pp, "00") & "R" If DWLD < 3 Then DWLD = DWLD + 1 GoTo DownloadRetry Else '* 時系列ダウンロード失敗 GoSub DownloadFailed Exit For End If Else Call JVLink1.JVClose Exit For End If End If NextRace: Call JVLink1.JVClose Next pp Call JVLink1.JVClose Next p Call JVLink1.JVClose Range("O5").Value = "[" & NENGAPPI & "] 時系列オッズ取得完了" DoEvents Exit Sub '------------------------------------------------------------------- ' サブルーチン '------------------------------------------------------------------- ' バッファ内容を読み取る ReadBufferData: '時系列オッズ解析 ID = Left$(buf, 2) Select Case ID '時系列単複枠オッズ読み込み Case "O1" p1 = p1 + 1 If p1 > DataCnt Then DataCnt = DataCnt + 1 ReDim Preserve DmyData(1 To DataCnt) As String End If Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Mid$(buf, 20, 2)) & _ " " & Mid$(buf, 26, 2) & "R 時系列単複枠オッズ解析中" DoEvents DmyData(p1) = Left$(buf, Len(buf) - 2) '馬連オッズ読み込み Case "O2" p1 = p1 + 1 If p1 > DataCnt Then DataCnt = DataCnt + 1 ReDim Preserve DmyData(1 To DataCnt) As String End If Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Mid$(buf, 20, 2)) & _ " " & Mid$(buf, 26, 2) & "R 時系列馬連オッズ解析中" DoEvents DmyData(p1) = Left$(buf, Len(buf) - 2) End Select Return ' --------------------------------------------------------- '* ワークシートにファイル情報を表示 DisplayFileInfo: With Worksheets("Top") q = .Range("O9").Value '* ファイル情報 .Range("N" & 11 + q).Value = dataspec '* ファイル名 .Range("O" & 11 + q).Value = Left(filename, Len(filename) - 4) & ".dat" '* 開催年月日 .Range("P" & 11 + q).Value = "'" & NENGAPPI '* データ区分 .Range("Q" & 11 + q).Value = "" '* データ数 If dataspec = "0B41" Then .Range("R" & 11 + q).Value = FileLen(CopyFile$) / O1DataSize ElseIf dataspec = "0B42" Then .Range("R" & 11 + q).Value = FileLen(CopyFile$) / O2DataSize End If .Range("O9").Value = q + 1 End With Return '* --------------------------------------------------------- '* 時系列オッズのセーブ TimeChangeOddsSave: Select Case ID Case "O1" Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Mid$(filename, 23, 2)) & _ " " & Mid$(filename, 25, 2) & "R 時系列単複枠オッズセーブ中" DoEvents Case "O2" Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Mid$(filename, 23, 2)) & _ " " & Mid$(filename, 25, 2) & "R 時系列馬連オッズセーブ中" DoEvents End Select '* セーブするファイルのパスを設定 CopyFile$ = COPY_DIR & "\" & NENGAPPI & "\" & Left$(filename, Len(filename) - 4) & ".dat" FN = FreeFile Open CopyFile$ For Output As #FN For p1 = 1 To DataCnt Print #FN, DmyData(p1) Next p1 Close #FN Return '------------------------------------------------------------------- ' 時系列ダウンロード失敗 DownloadFailed: Select Case dataspec Case "0B41" Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Format(p, "00")) & _ " " & Format(pp, "00") & " R 時系列単複枠オッズ取得できませんでした。" Case "0B42" Range("O5").Value = "[" & NENGAPPI & "] " & KeibajoName(Format(p, "00")) & _ " " & Format(pp, "00") & " R 時系列馬連オッズ取得できませんでした。" End Select DoEvents Call JVLink1.JVClose Return End Sub プログラムのポイント速報オッズと同様にレース単位で取得するので、開催日と場所コード、レース番号を特定してダウンロードする必要があります。時系列で提供されるためにオッズデータの量は大きくなりますが、扱うデータは"O1"あるいは"O2"のみなので処理はそうややこしくありません。ただこれもサーバーエラー（タイムアウト）でダウンロードに失敗することもあります。エラー(-1)の場合、通常はその場所のデータがない場合を示しますが、JVLinkのエラーメッセージにバグがあり、ダウンロードに失敗しても(-1)になるので、開催場所と一致するかどうかでエラー処理する工夫が必要です。ここでは10場所全部を総当りにチェックし、1レースのデータがないときにエラー(-1)を出しますが、開催場所と一致しなければもともとデータがない（正常）として次の場所を探します。もし開催場所と一致していれば取得に失敗したとみて3回までリトライするようにしています。（注意）このJVLinkのバグはタイムアウトのときにサーバーエラー(-413）とせず、データなし(-1)というメッセージを出すものです。すでに改修済みのはずですが、上記コードはそのまま使えると思います。自信はないですが。。。
⑨次に場所コードを競馬場名に変換するファンクションサブルーチン（関数マクロ）を作ります。[KeibajoName] 標準モジュールを挿入して、名前を"mMod3"とします。下記コードをmMod3に記述してください。 Option Explicit '**************** 場所コードを場所名に変換するファンクション(mMod3) ***************** '**** 戻り値＝競馬場名 '[第６回] Public Function KeibajoName(ByVal BaCode As String) As String If Val(BaCode) >= 1 And Val(BaCode) <= 10 Then KeibajoName = Choose(Val(BaCode), "札幌", "函館", "福島", "新潟", "東京", _ "中山", "中京", "京都", "阪神", "小倉") Else KeibajoName = "地方" End If End Function プログラムの説明これは引数としてBaCodeに"01"～"10"の競馬場コードを与えるとその数値に対応した場所名をChoose関数で選択して戻り値として戻します。"01"～"10"以外のデータを与えた場合はすべて”地方”場所として返します。以上が終わったら、上書き保存をしてください。
プログラムの実行 ”Top”シートのコンボボックスで開催日の「年月日」を選択して、＜速報系データ取得[0BXX]＞ボタンをクリックしてプログラムを実行してください。速報系データは開催日の日付でないと取得できません。当然開催日前の木曜・金曜は取得できません。該当する速報系データを順次ダウンロードしてワークシートに表示します。下図のように表示されれば正常です。”B9”セルのデータ数は112程度になると思います。以上で、速報系データをダウンロードするプログラムは完成、つまりこれで３つのダウンロードプログラムが完成です。注意：この速報系もファイル名をダブルクリックしてもワークシートに展開はしません。展開するプログラムは次回以降で作成します。
使い方の注意（１）”レース補てん情報[RCOV]”は、一度ダウンロードすると次週に新しいデータになるまでダウンロードしません。替わりにセーブしたファイルを表示します。（２）”レース情報[RACE]”は、開催日前～開催日当日～月曜の取得タイミングにより、取得できる内容が変わります。同じものが取得できる場合もあれば、同じデータが取得できない場合もあります。実際にどんなデータが取得できるのか仕様書と比較しながらやってみたら理解できると思います。確定後は同じデータになるので[RCOV]同様にセーブしたファイルを表示します。（３）”速報系データ[0BXX]”も取得のたびにデータが変わります。このためFromtimeという考えはありません。開催日当日のオッズは時刻により内容がどんどん変わります。”速報系データ”は開催日以前は前日発売出ない限り取得できません。過去のデータでも１年以内であればたぶん取得できると思います。

ページトップへ