Excel VBA質問箱 IV

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

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


12564 / 13646 ツリー ←次へ | 前へ→

【9893】インターネットからデータを自動取得できるんでしょうか? トモ 03/12/19(金) 20:22 質問
【9904】Re:インターネットからデータを自動取得でき... Ron 03/12/20(土) 16:35 回答
【9905】Re:インターネットからデータを自動取得でき... Ron 03/12/20(土) 16:37 回答
【9908】Re:インターネットからデータを自動取得でき... トモ 03/12/20(土) 17:43 質問
【9909】Re:インターネットからデータを自動取得でき... Ron 03/12/20(土) 19:21 回答
【9910】ありがとうございました! トモ 03/12/20(土) 19:57 お礼

【9893】インターネットからデータを自動取得でき...
質問  トモ  - 03/12/19(金) 20:22 -

引用なし
パスワード
   初めて質問させていただきます。

ExcelのVBAで、インターネットのページから
条件にあったデータを自動取得する仕組みを作ることはできるのでしょうか?

具体的な事例で説明させていただきますと、
例えば以下のページから、業種を「水産・農林業」を選んで検索して、
その結果として表示された一覧表をExcelに取り込む、
といった操作をすべてVBAで実現したいのです。
http://finance.nifty.com/stocks/servlet/stocks034

どなたかご存知であればぜひ教えていただきたいです。
よろしくお願いいたします。

【9904】Re:インターネットからデータを自動取得で...
回答  Ron E-MAIL  - 03/12/20(土) 16:35 -

引用なし
パスワード
   こんにちは。
とりあえず、サンプルとして。1ページ目のみの取得です。
Sub getWebData2()

  Const myURL = "http://finance.nifty.com/stocks/servlet/stocks034"
  Dim myIE As New InternetExplorer
  Dim myObj As Object
  Dim i As Long, j As Long
  Dim myTitle As Variant
  myTitle = Array("コード", "銘柄名", "市場", "業種", "現在値", "前日比", "総合診断")
  myIE.Visible = True
  myIE.navigate myURL
  
  Do While myIE.Busy = True
    DoEvents
  Loop
  On Error GoTo trap
  myIE.document.form1("type").Value = "0050"
  On Error GoTo 0
  myIE.document.form1.submit
  Do While myIE.Busy = True
    DoEvents
  Loop
  i = 1
  Cells.Delete
  Range("a1").Resize(, 7).Value = myTitle
  For Each myObj In myIE.document.all("formpl").all
    If myObj.tagName = "TR" Then
      i = i + 1
      j = 1
    End If
    If myObj.tagName = "TD" Then
      If j <= 7 Then Cells(i, j).Value = myObj.innerText
      j = j + 1
    End If
  Next
  
  Exit Sub
  
trap:
  MsgBox "NG"
End Sub
結構不安定なので、たまに失敗("NG")します。
では。

【9905】Re:インターネットからデータを自動取得で...
回答  Ron E-MAIL  - 03/12/20(土) 16:37 -

引用なし
パスワード
   1つ大事な事をわすれてました。
Microsoft Internet Controlsに参照設定してください。

【9908】Re:インターネットからデータを自動取得で...
質問  トモ  - 03/12/20(土) 17:43 -

引用なし
パスワード
   Ronさんありがとうございます!
自力ではとても作れないプログラムなので本当に嬉しいです。
無理かなと思っていたので感動しました。

お手数ながらもう少し教えていただきたいところがあるのですが、
作っていただいたプログラムを私のパソコンで実行しますと、

26行目あたりの、
「For Each myObj In myIE.Document.all("formpl").all」
のところで、

「実行時エラー'91':
 オブジェクト変数または With ブロック変数が設定されていません。」

というエラーのメッセージボックスが出ます。(毎回)

しかしなぜか、「デバッグ」を押してから「継続」ボタンを押すと、そのまま問題なく実行されます。
なお、プログラムは「標準モジュール」のところに書いたのですが、それで合ってるのでしょうか?

それから、検索結果が複数ページに渡った場合(業種を「建設業」にした場合等)に、
2ページ目以降のデータも取得することはできるのでしょうか?

重ねて質問させて頂き恐縮ですが、また教えていただければ幸いです。
では失礼します。

【9909】Re:インターネットからデータを自動取得で...
回答  Ron E-MAIL  - 03/12/20(土) 19:21 -

引用なし
パスワード
   こんばんは。
↓で表示待ちをしていましたが、非同期なようで
Do While myIE.Busy = True
  DoEvents
Loop
↓を追加して待ちます(3秒)。時間は環境に合わせてください。
Application.Wait Now() + TimeValue("00:00:03")

次ページ以降にも対応させました。
尚、業種IDは、トップページのソースに<OPTION Value="2050">建設業のような感じで書いてありますので、確認してリストを作っておくと便利です。
建設業は2050ですので、InputBoxが表示されたら2050と入力してお試しください。

Sub getWebData3()

  Const myURL = "http://finance.nifty.com/stocks/servlet/stocks034"
  Dim NextURL As String
  Dim myIE As New InternetExplorer
  Dim GyoshuID As String
  Dim myObj As Object
  Dim i As Long, j As Long
  Dim myTitle As Variant
  Dim PageCnt As Long
  
  GyoshuID = InputBox("業種IDを4桁で入力してください", "業種選択")
  myTitle = Array("コード", "銘柄名", "市場", "業種", "現在値", "前日比", "総合診断")
  myIE.Visible = True
  myIE.navigate myURL
  
  Do While myIE.Busy = True
    DoEvents
  Loop
  Application.Wait Now() + TimeValue("00:00:03")
  On Error GoTo trap
  myIE.document.form1("type").Value = GyoshuID
  
  On Error GoTo 0
  myIE.document.form1.submit
  
  i = 1
  Cells.Delete
  Range("a1").Resize(, 7).Value = myTitle
  Do
    Do While myIE.Busy = True
      DoEvents
    Loop
    Application.Wait Now() + TimeValue("00:00:03")
    
    For Each myObj In myIE.document.all("formpl").all
      If myObj.tagName = "TR" And myObj.innerText <> "" Then
        i = i + 1
        j = 1
      End If
      If myObj.tagName = "TD" Then
        If j <= 7 Then Cells(i, j).Value = myObj.innerText
        j = j + 1
      End If
    Next
    For Each myObj In myIE.document.all
      If myObj.innerText = "次へ" Then
        If InStr(1, myObj.innerHTML, "href") Then
          Exit For
        Else
          Exit Do
        End If
      End If
    Next
    PageCnt = PageCnt + 1
    NextURL = "javascript:document.form1.pageno.value='" & PageCnt & "n';document.form1.submit()"
    myIE.navigate NextURL

  Loop
  myIE.Quit
  Set myIE = Nothing
  MsgBox "終了しました"
  
  Exit Sub
  
trap:
  MsgBox "NG"
End Sub
お試しください。

【9910】ありがとうございました!
お礼  トモ  - 03/12/20(土) 19:57 -

引用なし
パスワード
   Ronさんどうもありがとうございました!

すべて完璧に動きました。感動です。
「すごい!」の一言です。
さっそく大事に使わせていただきます。

このプログラムは私にとっては何百万円以上の価値があります。
お礼を何度言っても言い足りないですが、
本当にどうもありがとうございました!

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