JRAのHPにアクセス

 

Sub Main1
Dim objIE As Object 
Set objIE = CreateObject("internetexplorer.application")
objIE.Visible =true'false
objIE.navigate "http://www.jra.go.jp"
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop
End Sub

 「レース結果」に跳んで、さらに「過去レース検索画面」に跳ぶ

Sub Main2
Dim objIE As Object 
Set objIE = CreateObject("internetexplorer.application")
objIE.Visible =true'false
objIE.navigate "http://www.jra.go.jp"
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop

For Each objA In objIE.Document.all.tags("A")
If InStr(objA.outerHTML, "レース結果") > 0 Then
objA.Click
exit for
end if
next
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop

For Each objA In objIE.Document.all.tags("A")
If InStr(objA.outerHTML, "過去レース検索画面はこちらをご覧ください。") > 0 Then
objA.Click
exit for
end if
next
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop
End Sub

「 Do While ・・・Loop」と「For Each ・・・next」をFunction化する

Main2をFunction入りに書き換え

Function ReadyState(ByRef objIE As Object)
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop
'wait(500) '0.5 秒 (500 ミリ秒) 
End Function

Function Link(ByRef moji As string , objIE As Object )
For Each objLink In objIE.document.Links
If InStr(objLink.outerHTML, moji) > 0 Then
objLink.Click
exit for
end if
next
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop
'Wait (500) '0.5 秒 (500 ミリ秒)
End Function

Sub Main3
Dim objIE As Object 
Set objIE = CreateObject("internetexplorer.application")
objIE.Visible =true'false
objIE.navigate "http://www.jra.go.jp"
call ReadyState(objIE)
call Link("レース結果" , objIE)
call Link("過去レース検索画面はこちらをご覧ください。" , objIE)
End Sub

「For Each ・・・next」では時間が掛かるので

ソースからパラメータをコピーしてobjIE.navigate に貼り付け

Sub Main4
Dim objIE As Object 
Set objIE = CreateObject("internetexplorer.application")
objIE.Visible =true'false
objIE.navigate "http://www.jra.go.jp"
call ReadyState(objIE)
objIE.navigate "JavaScript:doAction('/JRADB/accessS.html','pw01skl00999999/B3')"
call ReadyState(objIE)
End Sub

過去レース検索画面で年・月を入力する

Sub Main5
Dim objIE As Object 
Set objIE = CreateObject("internetexplorer.application")
objIE.Visible =true'false
objIE.navigate "http://www.jra.go.jp"
call ReadyState(objIE)
yy=2018
mm=8
ThisYear=Format(Date,"yyyy")
yIndex=ThisYear-yy
mIndex=mm-1
objIE.navigate "JavaScript:doAction('/JRADB/accessS.html','pw01skl00999999/B3')"
call ReadyState(objIE)
objIE.Document.all.tags("SELECT")(0).selectedIndex =yIndex
objIE.Document.all.tags("SELECT")(1).selectedIndex =mIndex
objIE.Document.all.tags("A")(104).Click
call ReadyState(objIE)

srlParam=LinksParamArry("srl", objIE)
for n=0 to Ubound(srlParam)
msgbox srlParam(n)
next
End Sub

 

Function LinksParamArry(ByRef KeyWd As string, objIE As Object)As Variant 
dim Param() as string
For Each objLink In objIE.document.Links
If InStr(objLink.outerHTML,KeyWd) > 0 Then
outH=objLink.outerHTML
kac1=InStr(outH, "(")
kac2=InStr(outH, ")")
ReDim Preserve Param(n)
Param(n)="JavaScript:doAction" & mid(outH,kac1,(kac2-kac1)+1) 
n=n+1
end if
next
LinksParamArry=Param
End Function