| |
こんにちは。かみちゃん です。
>>そこで、”IPAT投票メインメニュー”から、締め切り時刻を抜き出そうと思った
>>のですが、先にも書いたように、締め切り時刻が表示されているべきところに、
>>ダイレクトに時刻が出ていなかったので、焦ってしまいました。
>
>たぶんできると思います。
>IPATメニューは、利用時間が限られているため、動作確認ができませんが、
>今週末でも確認でき次第、方法はお知らせできると思います。
この土日は、あまり時間がなく中央競馬の全投票が終わってしまったあとの書き込み
で恐縮ですが、以下のようなコードでできると思います。
Sub Sample()
Dim ID As String
Dim str_para_uh As String
Dim str_para_g As String
Dim str_para_i As String
Dim str_para_p As String
Dim str_para_r As String
Dim IE As Object
Dim URL As String
Dim Post() As Byte
Dim strHeader As String
Dim szBuf As String
Dim ln As Long
Dim FN As Integer
Dim strFileName As String
Dim rngResult As Range
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")
'==================================================
'※IPATから情報呼び出しに必要な情報を設定
'==================================================
With WS2
ID = .Range("B1").Value 'INET ID
str_para_i = .Range("B2").Value '加入者番号
str_para_p = .Range("B3").Value '暗証番号
str_para_r = .Range("B4").Value 'P-ARS番号
URL = .Range("B5").Value
str_para_g = "080" '自動付与
End With
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
Do While .Busy = True And .ReadyState <> 4
DoEvents
Loop
szBuf = .document.body.innerHTML
End With
'==================================================
'※IPATから情報呼び出しに必要な情報を抜き出す
'==================================================
ln = InStr(1, szBuf, "NAME=uh", vbTextCompare)
If ln > 0 Then
szBuf = Right$(szBuf, Len(szBuf) - ln)
szBuf = Left$(szBuf, InStr(szBuf, ">") - 2)
ln = InStr(1, szBuf, "VALUE=", vbTextCompare)
If ln > 0 Then
szBuf = Right$(szBuf, Len(szBuf) - ln - 6)
Else
szBuf = ""
End If
Else
szBuf = ""
End If
If szBuf <> "" Then
str_para_uh = szBuf '自動付与
End If
'==================================================
'IPAT投票メインメニューの表示
'==================================================
'以下のｈｔｔｐという文字は、全角になっているので、半角にしてください。
URL = Replace(URL, "ｈｔｔｐ://", "ｈｔｔｐs://") & "pw_020_i.cgi"
Post = StrConv("inetid=" & ID & "&uh=" & str_para_uh & "&g=" & str_para_g & "&u=" & str_para_i & str_para_p & str_para_r & "&i=" & str_para_i & "&p=" & str_para_p, vbFromUnicode)
strHeader = "Content-type: application/x-www-form-urlencoded" + vbCrLf
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate URL, , , Post, strHeader
Do While .Busy = True And .ReadyState <> 4
DoEvents
Loop
End With
strFileName = ThisWorkbook.Path & "\pw_020_i.html"
FN = FreeFile
Open strFileName For Output As #FN
Print #FN, IE.document.body.innerHTML
Close #FN
IE.Quit
Set IE = Nothing
With WS1
With .QueryTables.Add(Connection:= _
"URL;file:///" & strFileName, _
Destination:=.Range("A1"))
.Name = "OneDayShutubahyou"
.PreserveFormatting = False
.AdjustColumnWidth = False
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebDisableDateRecognition = True
.Refresh BackgroundQuery:=False
Set rngResult = .ResultRange
End With
.Activate
End With
Kill strFileName
MsgBox "IPAT投票メインメニュー情報を取得しました"
End Sub
Sheet2の
B1セルに IPATのINETID
B2セルに IPATの加入者番号
B3セルに IPATの暗証番号
B4セルに IPATのP-ARS番号
B5セルにIPATのURL "ｈｔｔｐ://www.ipat.jra.go.jp/"（先頭４文字は全角になっているので半角にしてください）
を設定します。
その上で、上記マクロを実行すると、Sheet1に「IPAT投票メイメニュー」の内容
が取得されます。
ポイントは、
IE.document.body.innerHTML
で表示内容のHTMLを取得してし、Webクエリで読み込んでいますが、
それができていれば、内容を解析するなど、別の方法もあるかと思います。
なお、サンプルファイルを作成して動作確認していますので、差し上げることはできます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 08/2/14(木) 0:37 -
