2017-10-16 35 views
0

我編寫了導航到特定網站(http://www.boxofficemojo.com/)的代碼,然後將電影標題從電子表格複製/粘貼到搜索欄中以搜索該標題並打開其個人電影頁面(第一種情況是「Rogue One:星球大戰的故事」),這將最終用於從我的電子表格中爲200部電影抓取數據在VBA中導航HTML - 不可靠的代碼問題

我的問題如下:當我當我手動運行它(f5)時,它無法可靠地工作 - 它可能會工作一次,但總是出軌,並最終導航到錯誤的網頁。更奇怪的是,如果我設置了斷點到最後一行代碼,然後遍歷最後的一行嗯,它的作品。我無法弄清楚這是爲什麼。代碼如下,任何想法將不勝感激!

Option Explicit 

'Start new subroutine 
Sub FilmScraper() 

'dimension (declare or set aside memory for) our variables 
Dim MovieCount As Integer 'counter 

Dim objIE As New InternetExplorer 
Dim Doc As HTMLDocument 
Dim oSearch As HTMLDivElement 
Dim SearchElement As MSHTML.IHTMLElementCollection 
Dim oResult As Object, Element As Object, myLink As Object 

'Counting the number of titles to search for (will eventually be my main loop) 
Sheets("2016").Select 
MovieCount = 200 

'open IE and navigate to box office mojo homepage 
With objIE 
    .Visible = True 
    .Navigate "http://www.boxofficemojo.com/" 
     Do While objIE.Busy Or objIE.ReadyState <> 4 
      DoEvents 
     Loop 
    Set Doc = objIE.Document 
End With 

'search for 1st title name in excel sheet 
Set oSearch = objIE.Document.forms("searchbox").elements("q") 
    oSearch.Value = Sheets("2016").Range("c3").Value 
    objIE.Document.forms("searchbox").getElementsByTagName("input")(1).Click 

Do While objIE.Busy Or objIE.ReadyState <> 4 
     DoEvents 
Loop 

'open title page in box office 
Set Doc = objIE.Document 
Set oResult = Doc.getElementById("body").getElementsByTagName("a") 
For Each Element In oResult 
    If Element.outerHTML Like "*/movies/?id=*" Then 
     Set myLink = Element 
     Exit For 
    End If 
Next Element 

objIE.Navigate myLink 

'Scrape website and paste into excel (TBD) 

末次

回答

0

我改寫了你的代碼有點

它的工作原理沒有hickup起步價小區C3的5部電影

Rogue One: A Star Wars Story 
happy death day 
marshall 
the foreigner 
the snowman 

地方的電影名單列表... 。將代碼調整爲您喜歡的電影列表

Option Explicit 

' ref 
'  Microsoft HTML Object Library 
'  Microsoft internet controls 

Sub FilmScraper() 

    'dimension (declare or set aside memory for) our variables 
    Dim MovieCount As Integer 'counter 

    Dim objIE As New InternetExplorer 
    Dim Doc As HTMLDocument 
    Dim oSearch As HTMLDivElement 
    Dim SearchElement As MSHTML.IHTMLElementCollection 
    Dim oResult As Object, Element As Object, myLink As Object 

    'Counting the number of titles to search for (will eventually be my main loop) 

    'Sheets("2016").Select ' this line does not do anything useful 

    MovieCount = 200 
    MovieCount = 5  ' test with 5 movies 

    'open IE and navigate to box office mojo homepage 
    With objIE 
     .Visible = True 
     .Navigate "http://www.boxofficemojo.com/" 
     Do While objIE.Busy Or objIE.ReadyState <> 4 
      DoEvents 
     Loop 
    End With 

    Set Doc = objIE.Document 

    Dim aaa As Range 
' For Each aaa In Sheets("2016").Range("c3").Resize(MovieCount) 
    For Each aaa In ActiveSheet.Range("c3").Resize(MovieCount) 

     'search for title name in excel sheet 
     Doc.forms("searchbox").elements("q").Value = aaa.Value 
     Doc.forms("searchbox").getElementsByTagName("input")(1).Click 

     Do While objIE.Busy Or objIE.ReadyState <> 4 
      DoEvents 
     Loop 

     'open title page in box office 
     Set Doc = objIE.Document 
     Set oResult = Doc.getElementById("body").getElementsByTagName("a") 
     For Each Element In oResult 
      If Element.outerHTML Like "*/movies/?id=*" Then 
       Set myLink = Element 
       Exit For 
      End If 
     Next Element 

     objIE.Navigate myLink 

     Do While objIE.Busy Or objIE.ReadyState <> 4 
      DoEvents 
     Loop 

     'Scrape website and paste into excel (TBD) 

     Set Doc = objIE.Document 
     Set oResult = Doc.getElementsByClassName("mp_box")(1).getElementsByClassName("mp_box_content") 
     aaa.Offset(0, 2).Value = oResult(0).innerText ' put result in second cell to right of movie name 


    Next aaa 
End Sub 
+0

謝謝!我有一些工作要做,我需要精確的HTML元素,但這是一個巨大的幫助。我很感激! – n1xn1x