Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


28095 / 76732 ←次へ | 前へ→

【53945】Re:WEBからデータを取り込むには?
発言  かみちゃん E-MAIL  - 08/2/17(日) 17:12 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>そこで、”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投票メインメニューの表示
 '==================================================
 '以下のhttpという文字は、全角になっているので、半角にしてください。
 URL = Replace(URL, "http://", "https://") & "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 "http://www.ipat.jra.go.jp/"(先頭4文字は全角になっているので半角にしてください)
を設定します。

その上で、上記マクロを実行すると、Sheet1に「IPAT投票メイメニュー」の内容
が取得されます。
ポイントは、
IE.document.body.innerHTML
で表示内容のHTMLを取得してし、Webクエリで読み込んでいますが、
それができていれば、内容を解析するなど、別の方法もあるかと思います。

なお、サンプルファイルを作成して動作確認していますので、差し上げることはできます。
1 hits

【53894】WEBからデータを取り込むには? あつし 08/2/13(水) 23:10 質問
【53895】Re:WEBからデータを取り込むには? かみちゃん 08/2/14(木) 0:37 発言
【53909】Re:WEBからデータを取り込むには? あつし 08/2/14(木) 14:31 質問
【53911】Re:WEBからデータを取り込むには? VBWASURETA 08/2/14(木) 15:08 発言
【53919】Re:WEBからデータを取り込むには? かみちゃん 08/2/15(金) 0:31 発言
【53920】Re:WEBからデータを取り込むには? あつし 08/2/15(金) 5:59 発言
【53945】Re:WEBからデータを取り込むには? かみちゃん 08/2/17(日) 17:12 発言
【53950】Re:WEBからデータを取り込むには? あつし 08/2/17(日) 23:57 発言
【54085】Re:WEBからデータを取り込むには? あつし 08/2/23(土) 22:49 お礼

28095 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free