MS Excel - jak wyciągnąć dane z tabelek na stronie za pomocą VBA

2
0
1

Chciałbym wyciągnąć dane z tabelki pod Geography oraz Sector a następnie wgrać je do arkusza w Excelu.

Za pomocą załączonego kodu udało mi się wyciągnąć dane z tabelki "Holdings" (niepotrzebne) oraz nagłówki w "Exposure Breakdowns". Dlaczego ten kod nie widzi danych, które mnie interesują?

Strona:

https://www.blackrock.com/uk/individual/products/284262/acs-world-ex-uk-equity-tracker-fund-class-x1-acc

Środowisko VBA:

Sub BrowseBreakdownsWithQueryStringAndXML()

Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLTables As MSHTML.IHTMLElementCollection

XMLPage.Open "get", "https://www.blackrock.com/uk/individual/products/284262/acs-world-ex-uk-equity-tracker-fund-class-x1-acc", False
XMLPage.send

HTMLDoc.body.innerHTML = XMLPage.responseText

ProcessHTMLPage HTMLDoc

End Sub

Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

Dim HTMLTables As MSHTML.IHTMLElementCollection
Dim HTMLTable As MSHTML.IHTMLElement
Dim HTMLRow As MSHTML.IHTMLElement
Dim HTMLCell As MSHTML.IHTMLElement

Set HTMLTables = HTMLPage.getElementsByClassName("fund-component fund-component-parent ppv3")

For Each HTMLTable In HTMLTables

For Each HTMLRow In HTMLTable.getElementsByTagName("tr")

'For Each HTMLCell In HTMLRow.getElementsByTagName("td")

For Each HTMLCell In HTMLRow.Children 'includes all Tags under "tr"
Debug.Print vbTab & HTMLCell.innerText

Next HTMLCell

Next HTMLRow

Next HTMLTable

End Sub

Zapytał
@ Arkadiusz_Kogutowski | 22.12.2017
- 1
- 0
- 0

1

Wygląda na to, że ta tabela jest generowana skryptem po załadowaniu strony, czyli nie ma jej w czystym HTML-u. Na szczęście i na to jest sposób. :)

x = InStr(HTMLDoc.body.innerHTML, "var subTabsCountriesDataTable =[") + 32
y = InStr(x, HTMLDoc.body.innerHTML, "];") - 1

tabela = Mid(HTMLDoc.body.innerHTML, x, y - x)
Debug.Print tabela

Komentarze (1)

Odpowiedział
@ Mirosław_Janiak | 22.12.2017
- 1
- 7
- 1

Komentarze

Dziękuję za odpowiedź, jednak nie umiem nabudować do tego kodu tak by działało. Mogę prosić o jakiś komentarz albo wskazówki jak to zrobić?

Skomentował : @ Arkadiusz_Kogutowski ,03.01.2018

1
0
0

1

W Twoim kodzie procedura ProcessHTMLPage HTMLDoc przeszukuje zwracany DOM strony za tabelką o określonej klasie, a następnie rozbiera ją na poszczególne komórki i drukuje je w oknie Immediate. Jak wspomniałem wcześniej, potrzebna Ci tabelka nie jest statycznym kodem HTML, tylko generuje ją przeglądarka po załadowaniu strony na podstawie zmiennej subTabsCountriesDataTable. Excel tego nie obsłuży (nie przetwarza danych otrzymanych z serwera), trzeba zatem dokopać się do tej zmiennej w HTML-u i przetworzyć jej tekstową zawartość na coś bardziej użytecznego. Moje poprzednie makro drukowało tekst w oknie Immediate, tu masz zrzut do aktywnego arkusza wraz z rozbiciem poszczególnych informacji na wiersze i kolumny:

Sub BrowseBreakdownsWithQueryStringAndXML()
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLTables As MSHTML.IHTMLElementCollection

'wysyłamy żądanie do strony
XMLPage.Open "get", "https://www.blackrock.com/uk/individual/products/284262/acs-world-ex-uk-equity-tracker-fund-class-x1-acc", False
XMLPage.send

'przepisujemy informację zwrotną (kod strony) do zmiennej
HTMLDoc.body.innerHTML = XMLPage.responseText

'znajdujemy początek zmiennej zawierającej potrzebne dane w kodzie strony
x = InStr(HTMLDoc.body.innerHTML, "var subTabsCountriesDataTable =[") + 32
'znajdujemy koniec tej zmiennej
y = InStr(x, HTMLDoc.body.innerHTML, "];") - 1

'pobieramy fragment kodu z samą zawartością zmiennej
tabela = Mid(HTMLDoc.body.innerHTML, x, y - x)
'usuwamy z tekstu cudzysłowy i nawiasy klamrowe {}
tabela = Replace(Replace(Replace(tabela, "{", ""), "}", ""), """", "")

'rodzielamy tekst na tablicę
arrTab = Split(tabela, ",")

'sprawdzamy, ile otrzymaliśmy rekordów
ile = UBound(arrTab) + 1

'czyścimy bieżący arkusz
ActiveSheet.UsedRange.ClearContents

'zwracamy tablicę do arkusza
With Range("a1").Resize(ile, 1)
   'przerzucamy wartości do kolumny
   .Value = WorksheetFunction.Transpose(arrTab)
   'rozdzielamy tekst na dwie kolumny
   .TextToColumns DataType:=xlDelimited, DecimalSeparator:=".", OtherChar:=":"
End With

End Sub

Komentarze (2)

Odpowiedział
@ Mirosław_Janiak | 03.01.2018
- 1
- 7
- 1

Komentarze

Rewelacja, bardzo dziękuję, to jest własnie to czego mi było potrzeba!
Jeszcze tylko się upewnię, czy deklaracje do poprawnego działania powinny wyglądać następująco?
Dim x As Long
Dim y As Long
Dim ile As Long
Dim Tabela As String
Dim arrTab As Variant

Skomentował : @ Arkadiusz_Kogutowski ,03.01.2018

1
0
0

Jest ok :)

Skomentował : @ Mirosław_Janiak ,03.01.2018

1
7
1

Pytanie