JRAオッズ取得ワイドのオッズを取得 MSXML2.XMLHTTPとCreateObject("htmlfile")を使用してデバッグ

JRAのホームページから、
ワイドと三連複のオッズを取得したい
と質問があったので、
まず、ワイドのオッズ取得にチャレンジしてみます。

私Ken3が大好きだったIEのサポートが終了したので、
MSXML2.XMLHTTP
と
CreateObject("htmlfile")を使用して
JRAオッズ取得ワイドのオッズ取得に挑戦してみました。

#JRA #競馬 #オッズ取得 #ワイドオッズ
#IEサポート終了 #MSXML2.XMLHTTP #htmlfile #デバッグ
#ExcelVBA #MSExcel

下記、いつもの解説動画です。
とても※長いので休憩を取りながら、ソースコードと一緒にみてください。
途中コーヒー休憩、ブレイクタイム必要です。ぉぃぉぃ。
www.youtube.com
https://www.youtube.com/watch?v=XnIN8XRi-yA
目次
00:00 あいさつ実行結果やりたいこと
01:55 1.開催日・場所は、流用する
10:08 2.ワイドのオッズを押す
11:55 2.1 strレースを探し、頭出し？
18:47 3.オッズのテーブルを判断して、Excelにワイドオッズを取得
21:37 3.1 tableのcaptionで判断
28:30 4.ワイドの一番人気を探す
31:17 元に戻って、2.4 ２回目以降は、レースを選択

視聴者の声:「30分は、長いなぁ・・・」

Ken3:次回からは、ポイントをまとめるように努力します。(※努力義務で逃げるのかよ、大人って汚いな・・・)

あいさつ実行結果やりたいこと
まず、ワイドのオッズ取得に挑戦してみます。

1.開催日・場所は、流用する
単勝オッズの取得から、
開催日と場所の選択は単勝オッズ取得から流用しました。
ken3memo.hatenablog.com
↑に前回の単勝オッズのVBA ソースコードがあるので、合わせてみてください。

2.ワイドのオッズを押す

'リンクから、レースのTR行を探し、列ここではワイドなどを返す 20220924追加修正
strLINK = IE_Link_InnerHTML_InStr_TR_TD(oDocument, strRACE, "ワイド")

みたいに、レースとワイドで指定したリンクを取り出す。

何言ってんだか・・・

オッズのリンクが
1R 単勝複勝枠連馬連ワイド馬単 3連複 3連単
2R 単勝複勝枠連馬連ワイド馬単 3連複 3連単
・
・
・
11R 単勝複勝枠連馬連ワイド馬単 3連複 3連単
12R 単勝複勝枠連馬連ワイド馬単 3連複 3連単

と、並んでいるので、

2.1 strレースを探し、頭出し？

2.2 次のリンクから、ワイドの文字を見つけるまで、ループ・・と処理してみた

2.3 言い訳
本当は、かっこよく、
レースを見つけたら、その行 TRを取り出して、
その中の列 TDを探す・・・なんて構想で、
関数名も調子よく

Public Function IE_Link_InnerHTML_InStr_TR_TD(oDocument As Object, _
strレース As String, _
str種類 As String) As String
と
IE_Link_InnerHTML_InStr_TR_TD
インナー、内側のHTMLから、TRとTDを探すっぼく書いてるけど、
あれれ、

If InStr(oDocument.Links(i).outerHTML, strレース) ＞ 0 Then '内側のHTML
↑やじるし、
あっ、これは、やっちゃいけない、コメントで嘘ついてる。
'内側のHTML ？
実物は、
InStr(oDocument.Links(i).outerHTML で比べてるし・・・
これがうわさの、コメント信じるな、ソースはうそをつかない・・ですね。

話がそれたけど、
処理は、
レースを探してから、
次に来るワイドの文字を探しただけでした。

2.4 ２回目以降は、レースを選択
複数レース取得の時は、
先頭ページに戻らないで、
そのまま、レースのみ選択する
※ワイドのオッズ表示のページにいるので、そこからレース選択のみでよい

strRACE = nRACE & "レース" '1Rなど文字にする

'リンクから該当するレースを探しクリックする "1R".."12R"
If str初回FLG = "初回" Then '初回はレースとワイドを探す
'リンクから、レースのTR行を探し、列ここではワイドなどを返す
strLINK = IE_Link_InnerHTML_InStr_TR_TD(oDocument, strRACE, "ワイド")
str初回FLG = "次はレース選択のみ" 'フラグを折る。何を入れてもいい
Else
'２回目以降は、レースのみ選択で良い。ワイドオッズの場所にいるので
'リンクから該当するレースを探しクリックする "1R".."12R"
'Call IE_Link_InnerHTML_InStr_Click(oDocument, """" & strRACE & """")
strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, strRACE)
End If

3.オッズのテーブルを判断して、Excelにワイドオッズを取得

21:37
3.1 tableのcaptionで判断

＜table class="basic narrow-xy wide"＞
＜caption＞1＜/caption＞
＜tbody＞

と、
テーブルのキャプションで判断する。
JRAさんのページはしっかり作られていて、勉強になりますね。
初めて、
object HTMLTableCaptionElement

Watch : - : objTABLEs(i) : "[object HTMLTableElement]" : Variant/Object/HTMLTable :
- : caption : : Variant/Object/HTMLTableCaption :
: innerText : "1" : Variant/String : Module6.ie_JRAワイドオッズをレース別に複数蓄積する

を使ってみた。

If objTABLEs(i).Caption.innerText = n馬番
みたいな感じで、
1から判断してみた。

3.2 あとは、いつもの objTABLE.Rows.Length で縦の行を移動させて書き込む

                '表をDATAシートに書き出す
                'テーブルからデータを抜き出す、書き出す
                For y = 0 To objTABLE.Rows.Length - 1  '行のループ
                    'データをセルに書く 馬番 - 馬番  ワイドオッズ
                    Cells(SET_Y, 1) = objTABLEs(i).Caption.innerText '馬番 ここはテーブルのキャプション
                    Cells(SET_Y, 2) = "‐"
                    Cells(SET_Y, 3) = objTABLE.Rows(y).Cells(0).innerText  '馬番
                    Cells(SET_Y, 4) = objTABLE.Rows(y).Cells(1).innerText  'ワイドオッズ 10.1-11.2 など‐付きで入っているので、そのまま
                    SET_Y = SET_Y + 1
                Next y

28:30
4.ワイドの一番人気を探す

7.1-7.9
4.0-4.8
41.2-44.2

を手抜きで、
val("7.1-7.9")
とすると、7.1が取れるので、
比べてみた。

※１つのセルに入ってしまったので、桁がそろっていない
7.1- 7.9
41.2-44.2
4.0- 4.8
見た目を考えないとなぁ・・・

ソースコード全体を下に載せます、
アレンジして、使ってみてください。

IEサポート終了後の
MSXML2.XMLHTTP
と
CreateObject("htmlfile")を使用した処理
で何かの参考となれば幸いです。

ソースコード:

Option Explicit

'20220924 テスト
Sub ie_JRAワイドオッズをレース別に複数蓄積する()  'ワイドの取得テスト

    ActiveWindow.WindowState = xlMinimized '最小表示
    DoEvents
    Sleep 1000  '1秒待つ

    ActiveWindow.WindowState = xlNormal 'ノーマル表示
    DoEvents

'JRA TOP ページの表示
    '処理したいページをGET
    Dim strURL  As String
    Dim strHTML As String
    strURL = "https://www.jra.go.jp/"
    strHTML = get_htmlfile(strURL)  'JRA TOPをGetする

'TOPページ文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As Object
    Set oDocument = CreateObject("htmlfile")
    'Set oDocument = New HTMLDocument   '参照設定したとき
    'oDocument.write "<html><body>test</body></html>"  'HTMLをセット
    'Stop
    strHTML = Replace(strHTML, "script", "") 'scriptを止めるTEST

    oDocument.write strHTML  '取得したHTMLをセット
    DoEvents
    Sleep 1000  '1秒待つ
    'htmlfile_WAIT_TEST (oDocument)
    
    Dim objA As HTMLAnchorElement

    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer  'Excel側のセット位置
    Dim SET_X As Integer  'Excel側のセット位置
    
    Dim objCELL As HTMLTableCell

    Dim nRACE As Integer   'レース 1-12
    Dim strRACE As String  '文字列 1Rなどを作るため

    Dim Waku_str As String
    Dim Waku_n As Integer

'リンクからオッズを押す
    Dim strLINK As String
    strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, "オッズ")
    If strLINK = "ERR" Then
        MsgBox "オッズが見つかりません"
        Stop
    End If
    
    'オッズのページ HTMLを取り出す
    '<A onclick="doAction('/JRADB/accessO.html','pw15oli00/6D');return
    '文字列切り出し(strMOJI, "doAction('","','")
    '文字列切り出し(strMOJI, "','","')")
    Dim strPARA As String
    strURL = "https://www.jra.go.jp" & 文字列切り出し(strLINK, "doAction('", "','") 'URL
    strPARA = "cname=" & 文字列切り出し(strLINK, "','", "')")   'パラメーター
    strHTML = get_htmlfile_post(strURL, strPARA)  'パラメーターを付けて開く
    
    Set oDocument = Nothing
    Set oDocument = CreateObject("htmlfile")
    oDocument.write strHTML  '取得したHTMLをセット
    DoEvents
    Sleep 1000  '1秒待つ
    DoEvents

    '開催日のリンクをあさる
    strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, Sheets("MENU").Range("B2"))
    If strLINK = "ERR" Then
        MsgBox Sheets("MENU").Range("B2") & "が見つかりません"
        Stop
    End If
    
    strURL = "https://www.jra.go.jp" & 文字列切り出し(strLINK, "doAction('", "',") 'URL
    strPARA = "cname=" & 文字列切り出し(strLINK, "', '", "')")   'パラメーター
    strHTML = get_htmlfile_post(strURL, strPARA)  'パラメーターを付けて開く

    Set oDocument = Nothing
    Set oDocument = CreateObject("htmlfile")
    oDocument.write strHTML  '取得したHTMLをセット
    DoEvents
    Sleep 1000  '1秒待つ
    DoEvents

'1R-12R ワイドの表を取り込む
    
    Dim rワイドの列 As Range  '2022/09/24 一番人気を探すため
    Dim n一番人気 As Integer '一番人気の馬番受け取る。馬番=位置なんだけど・・・
    Dim strWORK As String    'C1にセットする文字列を作る
    
    Dim n馬番 As Integer     '馬は最大18頭
    Dim str初回FLG As String '初回はワイドをチェック、次からはレースのみで良い

    str初回FLG = "初回"      '初回で初期化

    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        'B5からのフラグが立っていたら And 最終じゃなければ
        'レースを取り込む
        If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 _
          And Sheets("MENU").Range("B4").Offset(nRACE, 1) <> "最終" Then
        
            '出力先をクリアする
            'まず、書き込み先シート、データをクリアする
            'Sheets(nRACE & "R").Select  'シートの切り替え
            Sheets("作業用").Select  'シートの切り替え
            Cells.Delete Shift:=xlUp 'シート全体を削除する
            Range("A1").Select       '先頭A1を選択する、
            SET_Y = 0  'セット位置を初期化
        
            strRACE = nRACE & "レース"   '1Rなど 文字にする
        
            'リンクから該当するレースを探しクリックする "1R".."12R"
            If str初回FLG = "初回" Then '初回はレースとワイドを探す
                'リンクから、レースのTR行を探し、列 ここではワイドなどを返す
                strLINK = IE_Link_InnerHTML_InStr_TR_TD(oDocument, strRACE, "ワイド")
                str初回FLG = "次はレース選択のみ"  'フラグを折る。何を入れてもいい
            Else
                '２回目以降は、レースのみ選択で良い。ワイドオッズの場所にいるので
                'リンクから該当するレースを探しクリックする "1R".."12R"
                'Call IE_Link_InnerHTML_InStr_Click(oDocument, """" & strRACE & """")
                strLINK = IE_Link_InnerHTML_InStr_Click(oDocument, strRACE)
            End If
            
            If strLINK = "ERR" Then  'エラーチェック
                MsgBox strRACE & "が見つかりません"
                Stop
            End If
            
            
            strURL = "https://www.jra.go.jp" & 文字列切り出し(strLINK, "doAction('", "',") 'URL
            strPARA = "cname=" & 文字列切り出し(strLINK, "', '", "')")   'パラメーター
            strHTML = get_htmlfile_post(strURL, strPARA)  'パラメーターを付けて開く
            
            Set oDocument = Nothing
            Set oDocument = CreateObject("htmlfile")
            oDocument.write strHTML  '取得したHTMLをセット
            DoEvents
            Sleep 1000  '1秒待つ
            DoEvents

            'Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

            'レース番号をセルに書く
            SET_Y = SET_Y + 1
            Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE
            Cells(SET_Y, 2) = JRA_Bodyからオッズの時刻を返す(oDocument)
            
            Sheets("MENU").Range("C4").Offset(nRACE, 0) = JRA_Bodyからオッズの時刻を返す(oDocument)
            Debug.Print "オッズ:" & JRA_Bodyからオッズの時刻を返す(oDocument)
            
            '発送時刻のセット
            'JRA_Bodyから発走時刻を返す
            Sheets("MENU").Range("A4").Offset(nRACE, 0) = strRACE & "発走" & JRA_Bodyから発走時刻を返す(oDocument)
            Debug.Print strRACE & "発走:" & JRA_Bodyから発走時刻を返す(oDocument)
            
            SET_Y = SET_Y + 1
        
            'ワイドの表を取り込む 表、テーブルを探る
            '見出しをセルに書く 馬番 - 馬番  ワイドオッズ
            Cells(SET_Y, 1) = "馬番"
            Cells(SET_Y, 2) = "‐"
            Cells(SET_Y, 3) = "馬番"
            Cells(SET_Y, 4) = "ワイドオッズ"
            SET_Y = SET_Y + 1
            
            'テーブルを探す
            'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
            
            For n馬番 = 1 To 17   '馬番は最大18頭、17-18が最後なのでMAX17までループ
                'TABLEタグを抜き 複数のテーブルをセット
                Set objTABLEs = oDocument.getElementsByTagName("TABLE")
                '↑で代入したオブジェクトからテーブルデータを取り出す｡
                
                Set objTABLE = Nothing  'オブジェクトを空にする
                For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
                    'テーブルのcaptionが処理する馬番かチェック
                    If objTABLEs(i).Caption.innerText = n馬番 Then '一致したテーブルGet
                        Set objTABLE = objTABLEs(i)  'みつけたらi番目を代入
                        Exit For
                    End If
                Next i
                
                '↑で見つかったかチェックする
                If objTABLE Is Nothing Then
                    '見つからなかったら、終わっていたら、ループを抜ける
                    Exit For  '抜ける
                End If
                
                '表をDATAシートに書き出す
                'テーブルからデータを抜き出す、書き出す
                For y = 0 To objTABLE.Rows.Length - 1  '行のループ
                    'データをセルに書く 馬番 - 馬番  ワイドオッズ
                    Cells(SET_Y, 1) = objTABLEs(i).Caption.innerText '馬番 ここはテーブルのキャプション
                    Cells(SET_Y, 2) = "‐"
                    Cells(SET_Y, 3) = objTABLE.Rows(y).Cells(0).innerText  '馬番
                    Cells(SET_Y, 4) = objTABLE.Rows(y).Cells(1).innerText  'ワイドオッズ 10.1-11.2 など‐付きで入っているので、そのまま
                    SET_Y = SET_Y + 1
                Next y
            Next n馬番
            
            SET_Y = SET_Y + 1  '空白を一行追加
            
            '作業用シートからレース別に転記する
            Sheets(nRACE & "R").Select  'シートの切り替え

            '初回か判断 レース場や開催日が変わっているか判断
            If Sheets("作業用").Range("A1") <> Range("A1") Then  'レース日や開催違いなら
                'シートをクリア
                Cells.Delete Shift:=xlUp 'シート全体を削除する
                Range("A1").Select       '先頭A1を選択する、
                '初回は、開催場所、見出しもコピーする
                Sheets("作業用").Range("A1:D" & SET_Y).Copy  'SET_Yまでコピー
                Range("A1").Select
                ActiveSheet.Paste
                'オッズの時刻をセット
                Sheets("作業用").Range("B1").Copy
                Range("D2").Select
                ActiveSheet.Paste
                Set rワイドの列 = Range("D2")   '初回はD2をセット 2022/05/15
            Else
                '二回目以降は、後ろに追記
                '元データをコピー
                Sheets("作業用").Range("D2:D" & SET_Y).Copy  'オッズの列
                '貼り付け先を探す
                For x = 1 To 256  '空白列を探す
                    'セル二行目のx列が空白か調べて抜ける
                    If Len(Trim("" & Cells(2, x))) = 0 Then Exit For
                Next x
                Cells(2, x).Select '貼り付け先を選択
                ActiveSheet.Paste
                Set rワイドの列 = Cells(2, x)   '貼り付けたx列をセット 2022/05/15
                
                '時刻を貼り付ける
                Sheets("作業用").Range("B1").Copy
                Cells(2, x).Select '貼り付け先を選択
                ActiveSheet.Paste
            End If
            
            '10倍以下を赤に、小数点をそろえ、一番人気を探す 2022/05/15
            n一番人気 = ワイド一番人気を探す(rワイドの列)  'ワイドの列から一番人気を探す
            strWORK = "ワイドの一番人気は "
            strWORK = strWORK & Range("a2").Offset(n一番人気, 0)
            strWORK = strWORK & " ハイフン "
            strWORK = strWORK & Range("a2").Offset(n一番人気, 2)
            
            strWORK = strWORK & " オッズは " & rワイドの列.Offset(n一番人気, 0) & " です"
            Range("c1") = strWORK
            
            '読み上げる※動画用
            DoEvents
            Range("B1").Clear
            Range("A1,C1").Speak  'A1とC1を読み上げ
            
        End If  'フラグが立っていたら↑
        
    Next

    'MENUに戻り、保存
    Sheets("MENU").Select
    Range("A3").Select
    ActiveWorkbook.Save
   
End Sub

'リンクから、レースのTR行を探し、列 ここではワイドなどを返す 20220924追加修正
'strLINK = IE_Link_InnerHTML_InStr_TR_TD(oDocument, strRACE, "ワイド")
'IEのリンクオブジェクトから文字列をInStrで探して返す
Public Function IE_Link_InnerHTML_InStr_TR_TD(oDocument As Object, _
                                                strレース As String, _
                                                str種類 As String) As String

    Dim i As Integer
    Dim objA As HTMLAnchorElement
    Dim strWORK As String
    Dim n As Integer
    
    'まず、リンクから受け取ったレース文字列を返す
    IE_Link_InnerHTML_InStr_TR_TD = "ERR"  '初期値にERRセット
    For i = 0 To oDocument.Links.Length - 1
        'レースの文字列を見つけたら　クリックじゃなかった次の種類を探す
        If InStr(oDocument.Links(i).outerHTML, strレース) > 0 Then '内側のHTML
            
            '本当は、見つけた行、TRを取得して、その中のTDを探した方がかっこいいけど
            'ここでは、カウンターのiを使い、iより後ろで見つかったものを返す
            'iとnのループカウンタ、添え時に注意してね
            For n = i + 1 To oDocument.Links.Length - 1
                'レースの文字列を見つけたら　クリックじゃなかった次の種類を探す
                If InStr(oDocument.Links(n).outerHTML, str種類) > 0 Then '内側のHTML
                    IE_Link_InnerHTML_InStr_TR_TD = oDocument.Links(n).outerHTML  '見つけたAタグオブジェ(リンク)を代入
                    Exit For  '↑同じ行TRのチェックしてないけど・・・
                End If
            Next n
            
            Exit For '見つけたのでループを抜ける ↑が同じTR行内のチェックしてないけどね・・・
        End If
    Next i
    
Debug.Print "リターン:" & IE_Link_InnerHTML_InStr_TR_TD
End Function

'2022/09/24 追加 ワイドの列 先頭(見出しの部分)を受け取り一番人気を返す
Public Function ワイド一番人気を探す(r As Range) As Integer
    Dim オッズ As Double
    Dim 一番人気 As Integer
    Dim n As Integer
    
    '初期値を代入
    'val("10.1 - 11.5") みたいにすると変換されるので、Valで手抜き変換
    オッズ = Val(r.Offset(1, 0)) '馬番1のオッズを初期値にする
    一番人気 = 1  '上から1番目を初期セット
    
    For n = 1 To 18 * 17 'MAX18*17まわす、といっても途中で抜けるならForじゃなくても・・
        With r.Offset(n, 0)  'n下のセルを操作したり値を比べる
            If Len(Trim("" & .Value)) = 0 Then Exit For 'データ無しなら抜ける
            '10倍以下なら、赤にする
            If Val(.Value) < 10 Then
                .Font.Color = -16776961 '赤にする
            End If
            'オッズを比べる
            If Val(.Value) < オッズ Then  '一時保存されているオッズより低かったら
                オッズ = Val(.Value) 'オッズを代入 更新
                一番人気 = n  '馬番nをセット
            End If
        End With
    Next
    
    ワイド一番人気を探す = 一番人気  'リターン値を返す
    '※まったく もう 日本語変数と関数名は良くないな・・・

End Function

前回単勝オッズから流用作成のコード

開催日と場所の選択は単勝オッズ取得から流用しました。
ken3memo.hatenablog.com
↑に前回の単勝オッズのVBA ソースコードがあるので、合わせてみてください。

#If Win64 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

'IEのリンクオブジェクトから文字列をInStrで探してクリックする
Public Function IE_Link_InnerHTML_InStr_Click(oDocument As Object, strINSTR As String) As String

    Dim i As Integer
    Dim objA As HTMLAnchorElement
    Dim strWORK As String
    Dim n As Integer
    'リンクから受け取った文字列を返す
    IE_Link_InnerHTML_InStr_Click = "ERR"  '初期値にERRセット
    For i = 0 To oDocument.Links.Length - 1
        '文字列を見つけたら　クリック
        If InStr(oDocument.Links(i).outerHTML, strINSTR) > 0 Then '内側のHTML
            
            IE_Link_InnerHTML_InStr_Click = oDocument.Links(i).outerHTML  '見つけたAタグオブジェ(リンク)を代入
            
            Exit For '見つけたのでループを抜ける
        End If
    Next i

End Function


Public Function JRA_Bodyからオッズの時刻を返す(oDocument As Object) As String

    Dim strTEMP As String
    Dim strRETURN As String  'リターン値
    Dim n As Integer
    
    'errでリターン値を初期化
    strRETURN = "ERR 文字列が見つかりませんでした"
    
    'HTMLのBODYテキストを代入
    strTEMP = oDocument.body.innerText

    'まず最終オッズを探す
    If InStr(strTEMP, "最終オッズ") > 0 Then
        strRETURN = "最終"
    End If

    '探す 13時03分現在オッズ  2018/12/09 修正
    '次週確認 7時03分現在オッズ 一けた台の時刻の時
    n = InStr(strTEMP, "現在オッズ")
    If n > 0 Then
        strRETURN = Mid(strTEMP, n - 6, 6)  '時刻を取り出す
    End If

    'リターン値をセット
    strRETURN = Replace(strRETURN, vbLf, "")  '改行vblfを""消す
    JRA_Bodyからオッズの時刻を返す = strRETURN

End Function

Public Function JRA_Bodyから発走時刻を返す(oDocument As Object) As String

    Dim strTEMP As String
    Dim strRETURN As String  'リターン値
    Dim n As Integer
    
    'errでリターン値を初期化
    strRETURN = "発走時刻が見つかりませんでした"
    
    'HTMLのBODYテキストを代入
    strTEMP = oDocument.body.innerText

    '5回中山4日 発走時刻：13時05分
    n = InStr(strTEMP, "発走時刻")
    If n > 0 Then
        strRETURN = Mid(strTEMP, n + 5, 6)  '後ろの時刻を取り出す
    End If

    'リターン値をセット
    JRA_Bodyから発走時刻を返す = strRETURN

End Function

'URLを受け取り、HTML文字列を返す(シフトJISページ用に変換後)
Public Function get_htmlfile(strURL As String) As String

    Dim objDOC As Object
    
    Set objHTML = CreateObject("MSXML2.XMLHTTP")
    
    objHTML.Open "GET", strURL, False
    'objHTML.overrideMimeType "text/plain; charset=Shift_JIS"
    DoEvents
    objHTML.send
    Sleep 250  '0.25秒待つ

    DoEvents
    Do While objHTML.readyState <> 4
        DoEvents
    Loop
    
    Dim strHTML As String
    'strHTML = objHTML.responseText
    strHTML = StrConv(objHTML.responseBody, vbUnicode)

    'テキスト確認 デバッグ用
    Dim strFNAME As String
    strFNAME = ThisWorkbook.Path & "\testhtml.txt"
    Open strFNAME For Output As #1
    Print #1, Now() & " に実行"
    Print #1, "strURL:" & strURL
    Print #1, strHTML
    Close #1

    'Debug.Print strHTML
    Sleep 250  '0.25秒待つ
    get_htmlfile = strHTML  'リターン値で返す

End Function


'URL,パラメータを受け取り、HTML文字列を返す(シフトJISページ用に変換後)
Public Function get_htmlfile_post(strURL As String, strPARA As String) As String

    Dim objHTML As Object
    
    Set objHTML = CreateObject("MSXML2.XMLHTTP")
    
    objHTML.Open "POST", strURL, False
    objHTML.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    objHTML.send (strPARA)
    DoEvents
    Sleep 250  '0.25秒待つ

    DoEvents
    Do While objHTML.readyState <> 4
        DoEvents
    Loop
    
    Dim strHTML As String
    'strHTML = objHTML.responseText
    strHTML = StrConv(objHTML.responseBody, vbUnicode)

    'テキスト確認 デバッグ用
    Dim strFNAME As String
    strFNAME = ThisWorkbook.Path & "\testhtml.txt"
    Open strFNAME For Output As #1
    Print #1, Now() & " に実行"
    Print #1, "strURL:" & strURL
    Print #1, "strPARA:" & strPARA
    Print #1, strHTML  'HTML
    Close #1

    'Debug.Print strHTML
    
    get_htmlfile_post = strHTML  'リターン値で返す

End Function

'左右のキーワードを受け取り、文字を切り出す
'<A onclick="doAction('/JRADB/accessO.html','pw15oli00/6D');return
'文字列切り出し(strMOJI, "doAction('","','")
'文字列切り出し(strMOJI, "','","')")
Public Function 文字列切り出し(strMOJI As String, strLEFT As String, strRIGHT As String) As String

    文字列切り出し = ""  'データ無しで初期化

    Dim nLEFT  As Integer
    Dim nSTART As Integer
    Dim n      As Integer
    
    '左側の位置を探す
    n = InStr(strMOJI, strLEFT)  '左側の区切り文字を探す
    If n = 0 Then Exit Function  '見つからない時抜ける
    
    '開始位置をセット
    nSTART = n + Len(strLEFT) '抜き取り開始位置

    '右側キーワードを探す
    n = InStr(nSTART, strMOJI, strRIGHT)  '右側の区切り文字を探す
    If n = 0 Then Exit Function  '見つからない時抜ける

    'MIDで抜き出す
    文字列切り出し = Mid(strMOJI, nSTART, (n - nSTART))

End Function

'2022/05/15 追加 単勝の列 先頭(見出しの部分)を受け取り一番人気を返す
'ついでに 10倍以下のオッズを赤に、小数点の桁をそろえる
Public Function 単勝一番人気を探す(r As Range) As Integer
    Dim オッズ As Double
    Dim 一番人気 As Integer
    
    '初期値を代入
    オッズ = r.Offset(1, 0) '馬番1のオッズを初期値にする
    一番人気 = 1  '馬番1を初期セット
    
    For n = 1 To 18  'MAX18頭まわす、といっても途中で抜けるならForじゃなくても・・
        With r.Offset(n, 0)  'n下のセルを操作したり値を比べる
            If Len(Trim("" & .Value)) = 0 Then Exit For 'データ無しなら抜ける
            '99.9 と 小数点の桁をそろえる
            .NumberFormatLocal = "0.0"
            '10倍以下なら、赤にする
            If .Value < 10 Then
                .Font.Color = -16776961 '赤にする
            End If
            'オッズを比べる
            If .Value < オッズ Then  '一時保存されているオッズより低かったら
                オッズ = .Value 'オッズを代入 更新
                一番人気 = n  '馬番nをセット
            End If
        End With
    Next
    
    単勝一番人気を探す = 一番人気  'リターン値を返す
    '※まったく もう 日本語変数と関数名は良くないな・・・

End Function