2017-02-01 5 views
0

をクリックによってナビゲートページからHTMLデータの取得。ここで私が抱えている問題は、次のとおりです。コードは、最初のいくつかのステップを経るが、それは2ページのHTMLを解析しようとすると、それは最初のページからHTMLを返します。何らかの理由で、画面に正しい情報が表示されているにもかかわらず、WebBrowser.DocumentのHTMLが新しい画面の読み込みで変更されることはありません。私はI.E.を強制しようとしました。ページが読み込まれるまで待つが、それは何の違いもないようだ。コードは次のとおりです:VBA:私は、ウェブページに移動し、いくつかの情報を入力し、ボタンをクリックし、次のページに移動し、そして得られた情報の一部を収集するために、VBAを使用しようとしている

Sub SnowLoad(Latitude As String, Longitude As String, State As String) 


Dim MyHTML_Element As IHTMLElement 
Dim HTMLDoc As HTMLDocument 
Dim MyURL As String 
Dim SnowTag As String 
Dim SnowPos As Long 
SnowTag = "Load" 
On Error GoTo Err_Clear 
MyURL = "http://snowload.atcouncil.org/" 
''open new explorer 
Dim MyBrowser As New InternetExplorer 
MyBrowser.Silent = True 
''navigate to page 
MyBrowser.navigate MyURL 
MyBrowser.Visible = True 
''wait until ready 
Do 
DoEvents 
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE 

Set HTMLDoc = MyBrowser.document 
HTMLDoc.all.optionCoordinate_LATLON.Click 

HTMLDoc.all.coordinate_lat.Value = Latitude 
HTMLDoc.all.coordinate_lon.Value = Longitude 
Set elems = HTMLDoc.getElementsByTagName("button") 
    For Each e In elems 

     If (e.getAttribute("class") = "btn") Then 
      e.Click 
      Exit For 
     End If 

    Next e 

Do 
DoEvents 
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE 

Set elems = HTMLDoc.getElementsByTagName("p") 

    For Each e In elems 
     Debug.Print e.innerHTML 
     If InStr(e.innerHTML, SnowTag) Then 
      SnowPos = InStr(e.innerHTML, SnowTag) 
      Range("SnowPosition").Value = SnowPos 
      Exit For 
     End If 

    Next e 

Err_Clear: 
If Err <> 0 Then 
Err.Clear 
Resume Next 
End If 

End Sub 

私の人生のために私は2番目のページに表示される情報を取得する方法を見つけることができません。グーグルの量は、答えやそれに類する問題を生じさせていないようです。 .navigateへの実際の呼び出しの代わりにボタンを使用してナビゲートすることに関連していますか?

+0

は、我々は、HTMLを見ることはできますか? 2つのうちの1つのように聞こえるが、コードはあなたのコードにもかかわらず完全に読み込まれていない。新しいページはフレーム/ iFrameにあります。または何か他のもの、ウェブサイトやHTMLを見て参考にする必要があります。 –

+0

私は(私は貼り付けるとき、それはtrainwreckに変わります)、元のポストに適切にフォーマットされたHTMLを取得する方法を見つけ出すように見えることはできません。ここにウェブサイトがあります: [Snow Link](http://snowload.atcouncil.org/index.php/component/vcpsnowload/item) 私はHTMLに精通していないので、私は完全にはわかりませんそれのいずれかが注目に値する。 – Tsnorthern

+0

特定の地域の降雪のpsfを返そうとしていますか? –

答えて

1

私は、これは確実に一見働くんです。私はそれを問題なく5〜6回走らせました。私はあまりにもページをリフレッシュした後に要素を見つけることができませんでした。これを回避するために、ロード後にオブジェクトへの新しいリファレンスを取得しました。それはうまくいくように見えました。

また、私は一般的には、コードの上にクリーンアップしました。

#If VBA7 Then 
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 
#Else 
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
#End If 

Sub SnowLoad() 
On Error GoTo errhand: 
    'I hard coded these for testing 
    Latitude = "46" 
    Longitude = "-87" 

    Dim MyURL  As String: MyURL = "http://snowload.atcouncil.org/" 
    Dim element  As Object 

    ''open new explorer, I used late binding 
    Dim MyBrowser As Object: Set MyBrowser = CreateObject("InternetExplorer.Application") 
    MyBrowser.Visible = True 
    MyBrowser.navigate MyURL 

    'Wait for the browser to finish loading 
    waitForLoad MyBrowser 

    With MyBrowser.document 
     .getElementByID("optionCoordinate_LATLON").Click 
     .getElementByID("coordinate_lat").Value = Latitude 
     .getElementByID("coordinate_lon").Value = Longitude 
     .getElementsByName("btn-submit")(0).Click 
    End With 

    waitForLoad MyBrowser 

    'For whatever reason the HTML isn't updating along with the page 
    'Instead, I'm just getting an updated reference to the IE object with the 
    'below function, weird issue, but this seems to work 
    Set MyBrowser = FindWindow("component/vcpsnowload/item") 
    Set element = MyBrowser.document.Forms("adminForm").getelementsByTagName("p")(0) 
    Range("A1").Value = element.innertext 

    Exit Sub 
errhand: 
    MsgBox (Err.Number & " " & Err.Description) 
End Sub 

Public Function FindWindow(SearchCriteria As String) As Object 
    Dim window As Object 

    For Each window In CreateObject("Shell.Application").Windows 
     If window.locationurl Like "*" & SearchCriteria & "*" Then 
      Set FindWindow = window 
      Exit Function 
     End If 
    Next 

    Set FindWindow = Nothing 
End Function 

Public Sub waitForLoad(ByVal IE As Object) 
    Dim i As Byte 
    Sleep 500 ' wait a bit for the page to start loading 
    Do 
     i = i + 1 
     Sleep 500 
    Loop Until IE.readystate = 4 Or IE.busy = False Or i >= 20 
End Sub 

上記のコードは、これを返している:Any elevation: Ground Snow Load is 60 psf

+0

問題はありません。うれしく思っています。本当に奇妙な問題ですが、私が知る限り、これを行うべきではありません。リフレッシュが完了したら、HTMLを更新する必要があります。 –

関連する問題