Trong Excel VBA, cách nào để kiểm tra xem trang web đã được tải hoàn toàn chưa?

Question

Để tạm dừng mã cho đến khi trang web được tải đầy đủ, tôi đã sử dụng phương pháp dưới đây với thành công lớn gần như mọi lúc.

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop 

Nhưng đôi khi, tôi thấy tải nội dung văn bản sau khi phương pháp xác định rằng trang được tải đầy đủ và để nội dung không được trích xuất.

Tuy nhiên, nếu tôi duyệt qua mã qua F8, nội dung sẽ được trích xuất mọi lúc. Điều này được thực hiện nhanh như tôi có thể nhấn phím F8 nhiều lần.

Vậy làm cách nào tôi có thể kiểm tra để đảm bảo trang và tất cả nội dung của trang, được tải đầy đủ trước khi mã tiếp tục trích xuất dữ liệu?

Trong cả hai trường hợp, IE đang chạy vô hình. Tuy nhiên, tôi đã thử điều này với IE có thể nhìn thấy và có thực sự nội dung trong vị trí cụ thể này trên các trang tôi đang làm việc với.

Việc này đang được thực hiện trong Excel 2016, sử dụng tập lệnh VBA. Yêu cầu nội dung cụ thể được viết như sau:

'get item name from page and write it to the first cell on the first empty row available 
Set itemName = objIE.document.querySelector(".the-item-name") 
Worksheets("Results").Range("A1048576").End(xlUp).Offset(1, 0).Value = itemName.innerText 

Tôi đã đọc qua Excel VBA: Wait for JavaScript execution in Internet Explorer bởi vì tôi nghĩ rằng có lẽ các giá trị đang nhận được thêm vào sau khi tài liệu được nạp, trong một nỗ lực để ngăn chặn bất cứ ai từ cào dữ liệu. Tuy nhiên, tôi dường như không thể xác định bất kỳ tập lệnh nào có thể làm điều đó. Không có nghĩa là nó không có ở đó. Tôi chưa thể nhìn thấy nó.

Một ví dụ cụ thể của trang với vấn đề này là URL

https://www.homedepot.ca/en/home/p.dry-cloth-refills-32---count.1000660019.html

Ban đầu product-total-price div yếu tố chứa dấu gạch ngang (-), trước khi giá đang được nạp, vì vậy đó là những gì được yêu cầu sẽ trở lại: -/each thay vì $11.29/each.

Tôi có giải pháp thay thế, nhưng không hiệu quả hoặc ngắn gọn như tôi muốn. Tôi kiểm tra chuỗi trả lại cho sự hiện diện của dấu gạch ngang. Nếu nó ở đó, lặp lại và kiểm tra nó một lần nữa, khác nắm bắt nó và chèn nó vào bảng tính.

setPriceUM: 
    Set hdPriceUM = objIE.document.querySelector(".product-total-price").innerTe‌​‌​xt 
    hdPriceUMString = hdPriceUM.innerText 
    stringTest = InStr(hdPriceUMString, "-") 
    If stringTest = True Then 
     GoTo setPriceUM 
    Else 
     Debug.Print hdPriceUMString 
    End If 

Cảm ơn bạn đã dành thời gian đọc và xem xét điều này.

Answer 1

Chức năng của trang web rất khác nhau, vì vậy không có giải pháp nào phù hợp với tất cả chúng.

Về ví dụ của bạn, cách giải quyết của bạn là một giải pháp làm việc, các mã có thể như:

Sub TestIE() 

    Dim q 

    With CreateObject("InternetExplorer.Application") 
     .Visible = True 
     .Navigate "https://www.homedepot.ca/en/home/p.dry-cloth-refills-32---count.1000660019.html" 
     ' Wait IE 
     Do While .readyState < 4 Or .Busy 
      DoEvents 
     Loop 
     ' Wait document 
     Do While .document.readyState <> "complete" 
      DoEvents 
     Loop 
     ' Wait element 
     Do 
      q = .document.querySelector(".product-total-price").innerText 
      If Left(q, 1) <> "-" Then Exit Do 
      DoEvents 
     Loop 
     .Quit 
    End With 
    Debug.Print q 

End Sub 

Dù sao, bạn cần phải nhìn vào quá trình tải trang web, XHRs và sửa đổi DOM, sử dụng các công cụ nhà phát triển trình duyệt (F12). Theo cách đó, bạn có thể thấy rằng một trong nhiều XHR trả về giá ở định dạng JSON. Nó được ghi lại trên tab mạng của các công cụ phát triển trình duyệt ngay trước khi giá xuất hiện trong khi trang đang tải. XHR đó được tạo bởi một trong các JS được tải, đặc biệt là sau khi sự kiện được tải trang.Hãy thử URL này (tôi chỉ cần sao chép nó từ tab mạng):

https://www.homedepot.ca/homedepotcacommercewebservices/v2/homedepotca/products/1000660019/localized/9999?catalogVersion=Online&lang=en

Vì vậy, bạn chỉ có thể sao chép XHR đó và trích xuất các giá bởi tách:

Sub TestXHR() 

    Dim q 

    With CreateObject("MSXML2.XMLHTTP") 
     .Open "GET", "https://www.homedepot.ca/homedepotcacommercewebservices/v2/homedepotca/products/1000660019/localized/9999?catalogVersion=Online&lang=en", False 
     .Send 
     q = .ResponseText 
    End With 
    q = Replace(q, " : ", ":") 
    q = Split(q, """displayPrice""", 2)(1) 
    q = Split(q, """formattedValue"":""", 2)(1) 
    q = Split(q, """", 2)(0) 
    Debug.Print q 

End Sub 

Nhưng một lần nữa, không có chung trường hợp.