三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

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 IEJRAのオッズを取得するコードを
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



下記、IEで作成したオッズ取得の過去記事
表の取り込みなど、ここから流用しています

ken3memo.hatenablog.com
ken3memo.hatenablog.com
ken3memo.hatenablog.com
ken3memo.hatenablog.com
ken3memo.hatenablog.com

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)