2017-05-31 3 views
0

ウェブサイトにログインし、htmlテーブルをExcelにコピーできる特定のページに移動するマクロを作成する作業が必要です。私の問題は、私がhtmlテーブルを取得しようとすると、私は以前のWebページのhtmlテーブルを取得します。私の考えは、HTMLDocumentをいくつかの方法で更新する必要があるということです。これは可能ですか?残念ながら、特定のURLを機密として提供することはできません。(VBA)同じブラウザで新しいHTMLページを移動するときにHTMLDocumentオブジェクトを更新するにはどうすればよいですか?

私のコードは以下の通りです。

Sub website_login() 

'variables 
Dim HTMLDoc As HTMLDocument 
Dim Browser As InternetExplorer 
Dim HTML_Element As IHTMLElement 
Dim URL As String 
Dim l As Object 

On Error GoTo Err_Clear 
URL = "MY URL" 

Set Browser = New InternetExplorer 
    Browser.Silent = True 
    Browser.navigate URL 
    Browser.Visible = True 

With Browser 
Do While .Busy Or .readyState <> 4 
    DoEvents 
Loop 
End With 

Set HTMLDoc = Browser.document 

'fill in login credentials 
HTMLDoc.getElementById("username").Value = "USERNAME" 
HTMLDoc.getElementById("password").Value = "PASSWORD" 

'loop through collection of INPUT tags and Login In 
For Each HTML_Element In HTMLDoc.getElementsByTagName("input") 
    If HTML_Element.Value = "Login" Then 
     HTML_Element.Click 
     Exit For 
    End If 
Next 

'will be brought back to login if delays aren't added 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 

Browser.navigate ("NEW URL")'navigate to new webpage on same website 


'BELOW CODE COPIES TABLE INTO EXCEL 
'http://www.ozgrid.com/forum/showthread.php?t=184695 
Dim eleColtr As MSHTML.IHTMLElementCollection 'Element collection for tr tags 
Dim eleColtd As MSHTML.IHTMLElementCollection 'Element collection for td tags 
Dim eleRow As MSHTML.IHTMLElement 'Row elements 
Dim eleCol As MSHTML.IHTMLElement 'Column elements 

Set eleColtr = HTMLDoc.getElementsByTagName("tr") 'Find all tr tags 
'This section populates Excel 
    i = 0 'start with first value in tr collection 
    For Each eleRow In eleColtr 'for each element in the tr collection 
     Set eleColtd = HTMLDoc.getElementsByTagName("tr")(i).getElementsByTagName("td") 'get all the td elements in that specific tr 
     j = 0 'start with the first value in the td collection 
     For Each eleCol In eleColtd 'for each element in the td collection 
      Sheets("Sheet1").Range("A1").Offset(i, j).Value = eleCol.innerText 'paste the inner text of the td element, and offset at the same time 
      j = j + 1 'move to next element in td collection 
     Next eleCol 'rinse and repeat 
     i = i + 1 'move to next element in td collection 
    Next eleRow 'rinse and repeat 



Debug.Print "DONE!" 
Exit Sub 
Err_Clear: 
If Err <> 0 Then 
Err.Clear 
Resume Next 
End If 


End Sub 
+0

あなたが実際に目的のページに移動_before_ ... –

+0

はおそらくページはまだ準備ができていない、第二の「browser.navigate」にreadyStateのを待つようにしてくださいDOMDOCUMENTを設定しています。 – Baro

+0

希望のページをナビゲートした後、HTMLDoc(Set HTMLDoc = Browser.document)をリセットするだけでいいですか?または、DOMdocumentの新しいインスタンスを作成する必要がありますか?速い応答のためにありがとうbtw – sourceCode

答えて

0

最終的に私のコードが動作するようになりました。ありがとうございました。 @Macro Manは、私が望むページに移動した後にDOMdocumentを設定しなかった点が正しいです。そこで私はBrowser.navigateの後にDOMdocumentの新しいインスタンスを作成しましたが、それは必要なものすべてではありません。何らかの理由で、新しいDOMドキュメントを設定する直前に、必要なページに再度移動する必要がありました。私はまだこれがなぜ機能するのか混乱していますが、誰がそれを気にしていますか。

Browser.navigate ("URL") 


Debug.Print "DELAY STARTED" 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 

Browser.navigate ("URL")'DONT REMOVE OR WILL BREAK 
Set WTF = Browser.document ' my new instance of DOMdocument 

Debug.Print "Second Delay" 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 
Application.Wait (Now + TimeValue("0:00:05")) ' delay 5 seconds 

'***************************************************************************************************************************************** 
'http://www.ozgrid.com/forum/showthread.php?t=184695 
Dim eleColtr As MSHTML.IHTMLElementCollection 'Element collection for tr tags 
Dim eleColtd As MSHTML.IHTMLElementCollection 'Element collection for td tags 
Dim eleRow As MSHTML.IHTMLElement 'Row elements 
Dim eleCol As MSHTML.IHTMLElement 'Column elements 

Set eleColtr = WTF.getElementsByTagName("tr") 'Find all tr tags 
'This section populates Excel 
    i = 0 'start with first value in tr collection 
    For Each eleRow In eleColtr 'for each element in the tr collection 
     Debug.Print "goodnews" 
     Set eleColtd = WTF.getElementsByTagName("tr")(i).getElementsByTagName("td") 'get all the td elements in that specific tr 
     j = 0 'start with the first value in the td collection 
     For Each eleCol In eleColtd 'for each element in the td collection 
      Sheets("Sheet1").Range("A1").Offset(i, j).Value = eleCol.innerText 'paste the inner text of the td element, and offset at the same time 
      j = j + 1 'move to next element in td collection 
     Next eleCol 'rinse and repeat 
     i = i + 1 'move to next element in td collection 
    Next eleRow 'rinse and repeat 
0

がテストされていない:

これで

Set eleColtr = HTMLDoc.getElementsByTagName("tr") 

を交換してみてください:

Set eleColtr = Nothing 
For i = 1 To 50 
    On Error Resume Next 
    Set eleColtr = HTMLDoc.getElementsByTagName("tr") 
    If Err.Number = 91 Then 
     GoTo Skip 
    End If 
    Exit For 
Skip: 
Application.Wait (Now() + TimeValue("00:00:001")) 
Next i 

私はあなたがまだ最後のテーブルの詳細情報を取得する場合は、これをテストしていませんが、 HTMLDocを再度設定する必要があります。

関連する問題