Sử dụng getElementById trên HTMLElement thay vì HTMLDocument

Question

Tôi đã chơi xung quanh bằng cách cào dữ liệu từ các trang web bằng VBS/VBA.

Nếu đó là Javascript tôi muốn được đi như dễ dàng của nó, nhưng nó không có vẻ là khá thẳng về phía trước trong VBS/VBA.

Đây là ví dụ tôi đưa ra câu trả lời, nó hoạt động nhưng tôi đã lên kế hoạch truy cập các nút con bằng cách sử dụng getElementByTagName nhưng tôi không thể tìm ra cách sử dụng chúng! Đối tượng HTMLElement không có các phương thức đó.

Sub Scrape() 
Dim Browser As InternetExplorer 
Dim Document As HTMLDocument 
Dim Elements As IHTMLElementCollection 
Dim Element As IHTMLElement 

Set Browser = New InternetExplorer 

Browser.navigate "http://www.hsbc.com/about-hsbc/leadership" 

Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE 
    DoEvents 
Loop 

Set Document = Browser.Document 

Set Elements = Document.getElementsByClassName("profile-col1") 

For Each Element in Elements 
    Debug.Print "[ name] " & Trim(Element.Children(1).Children(0).innerText) 
    Debug.Print "[ title] " & Trim(Element.Children(1).Children(1).innerText) 
Next Element 

Set Document = Nothing 
Set Browser = Nothing 
End Sub 

Tôi đã được nhìn vào HTMLElement.document tài sản, nhìn thấy nếu nó giống như một mảnh của tài liệu nhưng nó hoặc là khó khăn để làm việc với hoặc chỉ isnt những gì tôi nghĩ

Dim Fragment As HTMLDocument 
Set Element = Document.getElementById("example") ' This works 
Set Fragment = Element.document ' This doesn't 

cũng này có vẻ dài quanh co cách để làm điều đó (mặc dù thats thường là cách cho vba imo). Bất cứ ai cũng biết nếu có một cách đơn giản hơn để chuỗi chức năng?

Document.getElementById("target").getElementsByTagName("tr") sẽ là tuyệt vời ...

Answer 1

Tôi không thích điều đó.

Vì vậy, sử dụng javascript:

Public Function GetJavaScriptResult(doc as HTMLDocument, jsString As String) As String 

    Dim el As IHTMLElement 
    Dim nd As HTMLDOMTextNode 

    Set el = doc.createElement("INPUT") 
    Do 
     el.ID = GenerateRandomAlphaString(100) 
    Loop Until Document.getElementById(el.ID) Is Nothing 
    el.Style.display = "none" 
    Set nd = Document.appendChild(el) 

    doc.parentWindow.ExecScript "document.getElementById('" & el.ID & "').value = " & jsString 

    GetJavaScriptResult = Document.getElementById(el.ID).Value 

    Document.removeChild nd 

End Function 


Function GenerateRandomAlphaString(Length As Long) As String 

    Dim i As Long 
    Dim Result As String 

    Randomize Timer 

    For i = 1 To Length 
     Result = Result & Chr(Int(Rnd(Timer) * 26 + 65 + Round(Rnd(Timer)) * 32)) 
    Next i 

    GenerateRandomAlphaString = Result 

End Function 

Hãy cho tôi biết nếu bạn có bất kỳ vấn đề với điều này; Tôi đã thay đổi ngữ cảnh từ một phương thức thành một hàm.

Nhân tiện, bạn đang sử dụng phiên bản IE nào? Tôi nghi ngờ bạn đang ở trên < IE8. Nếu bạn nâng cấp lên IE8 tôi đoán nó sẽ cập nhật shdocvw.dll thành ieframe.dll và bạn sẽ có thể sử dụng document.querySelector/All.

Sửa

Comment phản ứng mà không phải là thực sự là một lời nhận xét: Về cơ bản các cách để làm điều này trong VBA là để đi qua các nút con. Vấn đề là bạn không có được kiểu trả về đúng. Bạn có thể sửa lỗi này bằng cách tạo các lớp của riêng bạn (riêng) triển khai IHTMLElement và IHTMLElementCollection; nhưng đó là quá nhiều nỗi đau cho tôi để làm điều đó mà không được trả tiền :). Nếu bạn đã xác định, hãy đọc và đọc trên từ khóa Implements cho VB6/VBA.

Public Function getSubElementsByTagName(el As IHTMLElement, tagname As String) As Collection 

    Dim descendants As New Collection 
    Dim results As New Collection 
    Dim i As Long 

    getDescendants el, descendants 

    For i = 1 To descendants.Count 
     If descendants(i).tagname = tagname Then 
      results.Add descendants(i) 
     End If 
    Next i 

    getSubElementsByTagName = results 

End Function 

Public Function getDescendants(nd As IHTMLElement, ByRef descendants As Collection) 
    Dim i As Long 
    descendants.Add nd 
    For i = 1 To nd.Children.Length 
     getDescendants nd.Children.Item(i), descendants 
    Next i 
End Function 

Answer 2

Sub Scrape() 
    Dim Browser As InternetExplorer 
    Dim Document As htmlDocument 
    Dim Elements As IHTMLElementCollection 
    Dim Element As IHTMLElement 

    Set Browser = New InternetExplorer 
    Browser.Visible = True 
    Browser.navigate "http://www.stackoverflow.com" 

    Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE 
     DoEvents 
    Loop 

    Set Document = Browser.Document 

    Set Elements = Document.getElementById("hmenus").getElementsByTagName("li") 
    For Each Element In Elements 
     Debug.Print Element.innerText 
     'Questions 
     'Tags 
     'Users 
     'Badges 
     'Unanswered 
     'Ask Question 
    Next Element 

    Set Document = Nothing 
    Set Browser = Nothing 
End Sub 

Answer 3

Nhờ dee cho câu trả lời ở trên với Cạo() chương trình con. Mã này hoạt động hoàn hảo như được viết và sau đó tôi có thể chuyển đổi mã để làm việc với trang web cụ thể mà tôi đang cố gắng xóa.

tôi không có đủ uy tín để upvote hoặc nhận xét, nhưng tôi thực sự có một số cải tiến nhỏ để thêm vào câu trả lời dee:

1. Bạn sẽ cần phải thêm tham khảo VBA qua "Tools \ Tài liệu tham khảo "tới" Thư viện đối tượng HTML của Microsoft để mã biên dịch.

2. Tôi đã nhận xét ra Trình duyệt.dòng Visible và bổ sung những nhận xét như sau

   'if you need to debug the browser page, uncomment this line: 
   'Browser.Visible = True 
   

3. Và tôi đã thêm một dòng để đóng trình duyệt trước khi thiết lập trình duyệt = Nothing:

   Browser.Quit 
   

Cảm ơn một lần nữa dee!

ETA: tính năng này hoạt động trên các máy có IE9, nhưng không hoạt động trên các máy có IE8. Có ai sửa chữa không?

Tìm thấy bản sửa lỗi, vì vậy hãy quay lại đây để đăng. Chức năng ClassName có sẵn trong IE9. Để làm việc này trong IE8, bạn sử dụng querySelectorAll, với dấu chấm đứng trước tên lớp của đối tượng mà bạn đang tìm kiếm:

'Set repList = doc.getElementsByClassName("reportList") 'only works in IE9, not in IE8 
Set repList = doc.querySelectorAll(".reportList")  'this works in IE8+