| |
こんばんは。
↓で表示待ちをしていましたが、非同期なようで
Do While myIE.Busy = True
DoEvents
Loop
↓を追加して待ちます（３秒）。時間は環境に合わせてください。
Application.Wait Now() + TimeValue("00:00:03")
次ページ以降にも対応させました。
尚、業種ＩＤは、トップページのソースに<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("業種ＩＤを４桁で入力してください", "業種選択")
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
お試しください。
|
|
- 03/12/20(土) 16:35 -
