CreateObject("htmlfile")でDocumentを作りweb上のhtmlデータを抜き出す例題でJRAオッズを取得してみた

Dim oDocument As Object
Set oDocument = CreateObject("htmlfile")
で作成したhtmlfileドキュメントオブジェクトに
html文字列を書き込む、そんなデバッグ風景です。

下記、いつものあのあのそのその解説動画です
www.youtube.com
https://www.youtube.com/watch?v=RjZZUq40gxY
目次
00:00 0.IEが無くなるので CreateObject("htmlfile")
00:26 1.DoEventsがないと処理が追い付かない？
03:25 2.oDocument.write って追記なの？
07:23 3.JRAオッズ取得を例題にデバッグ
08:17 文字化けの説明
10:00 CreateObject("htmlfile")でDocumentを作り
10:36 リンクからオッズのAタグを取り出す
12:02 URLとパラメーターを切り出す
12:57 POST処理 URLとパラメータをPOSTしてHTML結果をGet
13:48 取得したHTMLをデバッグ用テキストファイルへ落とす
14:22 再度 CreateObject("htmlfile")でDocument
14:50 開催地と開催日のリンクをあさる
16:45 1Rからオッズを取得最終取得後はスキップ
17:03 11Rのリンクを取り出す
18:03 11レースのオッズページHTMLを取得する
19:50 オッズ取得イメージ
20:30 おわりの挨拶

1.DoEventsがないと処理が追い付かない？
まぁ、たまたま、DoEvents入れて動いているのですが、
DoEventsを外すと、エラーになる、そんな実験をしてみる。

oDocument.write strHTML '取得したHTMLをセット
DoEvents
Sleep 1000 '1秒待つ
で、現在、たまたま、動いていますが、
これを外すと動かなくなる。
※処理待ちをうまく考えないとなぁ・・・

2.oDocument.write って追記なの？

oDocument.write "test" 'HTMLをセット
こんな感じで使っていますが、
テストしていて、気が付いた？勘違いかもしれませんが、
Document.write って追記されるの？
デバッグしてみる

3.JRAオッズ取得を例題にデバッグ

CreateObject("htmlfile")の使用例を説明する
なんか、軽く説明しようとしたら、
長くなってしまった・・・

昔作成したVBA IEでJRAのオッズを取得するコードを
CreateObject("htmlfile")を使ったコードに書き換えてます。
来週、また、テストしてみたいと思います。

<a onclick="doAction('/JRADB/accessO.html','pw15oli00/6D');return false;" href="#"><span class="icon"><i class="fa fa-caret-right" aria-hidden="true"></i></span><span class="txt">オッズ</span></a>

? oDocument.Links(i).outerHTML
<a onclick="return doAction('/JRADB/accessO.html', 'pw15orl00052022020220220424/1C');" href="#"><i class="fa fa-chevron-circle-right" aria-hidden="true"></i>2回東京2日</a>

? oDocument.Links(i).outerHTML
<a onclick="return doAction('/JRADB/accessO.html', 'pw151ouS305202202021120220424Z/72');" href="#"><img alt="11レース" src="/JRADB/img/race_select/btn_race_num11.png"></a>

Option Explicit

Sub test_001()

    Dim oDocument As Object
    Set oDocument = CreateObject("htmlfile")

    oDocument.write "<html><body>te<b>st</b></body></html>"
    'HTMLをセット
    oDocument.write "<html><body>test2</body></html>"
    oDocument.write "<html><body><p>test3</p></body></html>"
    oDocument.write "<html><body>test4</body></html>"
    Debug.Print "html:" & oDocument.body.innerHTML
    Stop

End Sub

GetとPOST シフトJISで文字化けしたり・・・・

'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