Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Makro do pobierania danych ze źródła strony WWW

fafas · Forumowicz Posty: 15

Dzień dobry, a raczej witam wszystkich:
Zajmuje się amatorsko szeroko pojętą muzyką. Często kupuję muzykę ze strony www.beatport.com. Niestety albo stety dziennie wychodzi ich tak dużo, że nie daje rady ręcznie ich sprawdzać. Utworzyłem sobie w exelu „skrypt bez VBA” do którego do tej pory wklejałem ręcznie zaznaczając tekst na www, następnie kopiując go do worda, notatnika i dalej exela. Jest to bardzo pracochłonne.
Potrzebuje makro które zgra ze „źródła strony” dla przykładu
view-source:https://www.beatport.com/releases/all?per-page=150&page=1 --> widok w przeglądarce google chrome lub mozilla .
Nazwe artysty, tytuł utworu, nazwę wytwórni tzw. label, gatunek muzyki, datę wydania , preorder, Exclusive, www do okładki.
W kodzie strony można odnaleźć dane które mnie interesują tj.
Nazwa artysty --> data-ec-d1="Van Bonn"
Tytuł utworu --> data-ec-name="Remote"
Nazwę wytwórni tzw. label --> data-ec-brand="Van Bonn Records"
Gatunek muzyki --> data-ec-d3="Techno"
Datę wydania --> <p class="buk-horz-release-released">2018-12-15</p>
Czy to preorder --> data-ec-d12="preorder">
Czy to exclusive --> <span class="exclusive-marker horz-release-bucket-exclusive-marker">Exclusive</span>
Odnośnik do strony okładki --> data-src="https://geo-media.beatport.com/image_size/250x250/64a68791-0d88-4fc6-921c-bbe553361bd7.jpg" />
PS. Tekst który mnie interesuje pogrubiłem. Na każdej podstronie znajduje się 150 utworów

Jednorazowo chciał bym importować około 40 do 50 podstron
view-source:https://www.beatport.com/releases/all?per-page=150&page=1
view-source:https://www.beatport.com/releases/all?per-page=150&page=2
…
view-source:https://www.beatport.com/releases/all?per-page=150&page=50
Niestety sam raczej nie podołam z tym VBA. Przekopałem sporo postów i nic nie znalazłem. Z góry dziękuję za pomoc.

DwaNiedźwiedzie · Wysłany: 10-12-2017, 20:04

Sprawdź poniższy kod. Namierzyłem tylko dwa problemy: zamiast linków do okładek podstawia się wciąż ten sam pusty jpg (brakuje jakiegoś atrybutu w nagłówku GET?) i nie pokazują się preordery (konstrukcja linku?). Skoro wymieniasz elementy strony, to może sam to rozgryziesz :)

Kod:

Sub BeatPort()
Set HTMLDoc = CreateObject("HTMLfile")
Set XMLObj = CreateObject("MSXML2.XMLHTTP")

ActiveSheet.UsedRange.Clear

stron = 5
r = 2
Range("a1:f1") = Array("okładka", "ex-pre", "tytuł", "artysta", "wytwórnia", "data wydania")

For i = 1 To stron
myURL = "https://www.beatport.com/releases/all?per-page=150&preorders=1&page=" & i
XMLObj.Open "GET", myURL, False
XMLObj.Send

HTMLDoc.body.innerhtml = XMLObj.responseText

Set ul = HTMLDoc.getElementsByTagName("ul")

For Each ul In HTMLDoc.getElementsByTagName("ul")
If ul.classname = "bucket-items ec-bucket filter-page-releases-list" Then
For Each li In ul.getElementsByTagName("li")
With li
With .Children(0).Children(0)
Cells(r, 1) = .Children(0).src
If .Children.Length > 1 Then Cells(r, 2) = .Children(1).innerText
End With

With .Children(1).Children(0)
Cells(r, 3) = .Children(0).innerText
Cells(r, 4) = .Children(1).innerText
Cells(r, 5) = .Children(2).innerText
Cells(r, 6) = .Children(3).innerText
End With
End With
r = r + 1
Next
Exit For
End If
Next

Application.StatusBar = "Zaciągniętych stron: " & i & " z " & stron
Next

Application.StatusBar = ""

End Sub

fafas · Forumowicz Posty: 15

Serdeczne dzięki !!! działa jak trzeba, jedyne czego mi brakuje to genre .... jest szansa abyś dorobił odnośnik do gatunku muzyki??

Co do linku do strony z okładką to :

Cytat:

W tym miejscu są dwa linki jeden stały do pustej strony, a drugi do linku z okladką. W tym kodzie pobiera cały czas ten pierwszy.

PS. mogę Cie prosić o szybkie objaśnienie kodu ... która część odpowiada za pobieranie np nazwy wykonawcy czy tytułu ...

DwaNiedźwiedzie · Wysłany: 11-12-2017, 00:21

Przerobiłem kod tak, żeby pobierał dane według atrybutów, możesz sobie nimi dowolnie żonglować w zmiennej atrybuty :) Objaśnienia w komentarzach:

Kod:

Sub BeatPort()
Set HTMLDoc = CreateObject("HTMLfile")
Set XMLObj = CreateObject("MSXML2.XMLHTTP")

'czyścimy arkusz
ActiveSheet.UsedRange.Clear

'zmienna określająca, ile stron chcemy przeszukać
stron = 10
'wiersz, od którego zaczynamy dopisywać
r = 2

'podajemy atrybuty elementu "LI" ze strony (wiersza z albumem), które chcemy pobrać
'listę można modyfikować: dodawać i usuwać elementy oraz zmieniać ich kolejność
atrybuty = Array("data-ec-d1", "data-ec-name", "data-ec-brand", "data-ec-d3", "data-ec-d12", "data-ec-variant", "data-ec-price", "data-ec-list", "data-ec-category", "data-ec-creative", "data-ec-type", "data-ec-position")
'wstawiamy wiersz nagłówka z nazwami atrybutów
Range("a1").Resize(1, UBound(atrybuty) + 1) = atrybuty
'dodajemy dwie osobne kolumny dla okładki i "ekskluzywa", które pobierane są w inny sposób (szczegóły niżej)
Range("a1").Offset(0, UBound(atrybuty) + 1).Resize(1, 2) = Array("link", "ex")

'przechodzimy przez wybrany zakres numerów
For i = 1 To stron
'ustawiamy adres z kolejną liczbą
myURL = "https://www.beatport.com/releases/all?per-page=150&preorders=mixed&page=" & i
'wysyłamy żądanie do serwera
XMLObj.Open "GET", myURL, False
XMLObj.Send

'przerzucamy odpowiedź do obiektu HTML dla łatwiejszego poruszania się po pobranej stronie
HTMLDoc.body.innerhtml = XMLObj.responseText

'wyszukujemy listy na stronie
Set ul = HTMLDoc.getElementsByTagName("ul")

'przeszukujemy te listy w poszukiwaniu tej z właściwą klasą
For Each ul In HTMLDoc.getElementsByTagName("ul")
'sprawdzamy klasę
If ul.classname = "bucket-items ec-bucket filter-page-releases-list" Then
'pobieramy kolejne wiersze listy
For Each li In ul.getElementsByTagName("li")
'wyłączamy obsługę błędów na potrzeby preorderów i exów (nie zawsze występują)
On Error Resume Next
'pobieramy wcześniej zdefiniowane atrybuty do kolejnych komórek
For atr = 0 To UBound(atrybuty)
Cells(r, atr + 1) = li.Attributes(atrybuty(atr)).Value
Next

'link do okładki i exy pobieramy nie z atrybutów całego wiersza, ale z elementów podrzędnych
With li.Children(0).Children(0)
'link z obrazka
Cells(r, atr + 1) = .Children(0).Attributes("data-src").Value
'ex z elementu sąsiadującego z obrazkiem
Cells(r, atr + 2) = .Children(1).innerText
End With
'przywracamy obsługę błędów
On Error GoTo 0

'zwiększamy numer wiersza
r = r + 1
Next
'wychodzimy z pętli wewnętrznej, w której szukaliśmy klasy
'ponieważ właściwy element został znaleziony
Exit For
End If
Next

'wrzucamy informację o postępie do paska stanu
Application.StatusBar = "Zaciągniętych stron: " & i & " z " & stron
Next

'resetujemy pasek stanu
Application.StatusBar = ""

End Sub

PS: U mnie wciąż nie pokazuje preorderów - ale pobierałem max 5 stron, może z poziomu excela sortowanie się zmienia i wrzuca je gdzieś dalej.

fafas · Forumowicz Posty: 15

Jeszcze lepiej ... :) można się połapać. Próbuje analogicznie do tego co napisałeś dodać datę aby skrypt pobierał datę... (w pierwszej wersji pobierało ją teraz nie pobiera) dodalem do kodu pogrubiony tekst ale niestety nie działa:
Range("a1").Offset(0, UBound(atrybuty) + 1).Resize(1, 2) = Array("link", "ex", "data")
oraz
Cells(r, atr + 3) = .Children(2).Attributes("buk-horz-release-released").Value
PS. oczywiście pogrubiłem tylko do co dodałem do kodu
preordery i exclusive na pierwszy rzut oka działają.
Jakiś pomysł dlaczego nie działa?? ... po wczytaniu nawet nie wyświetla nazwy data

DwaNiedźwiedzie · Wysłany: 11-12-2017, 16:28

Nagłówka "data" nie wyświetla, bo nie rozszerzyłeś zakresu, do którego makro wkleja nazwy, teraz powinno być Resize(1, 3).
buk-horz-release-released to nazwa klasy elementu z datą, a nie atrybut, także dotrzeć do niej trzeba ciut inaczej :) Wstaw poniższy kod po End With:

Kod:

Cells(r, atr + 3) = li.Children(1).Children(0).Children(3).innerText

fafas · Forumowicz Posty: 15

Magia oczywiście działa ... :) mogę poprosić dla siebie i innych o objaśnienie do li.Children(1).Children(0).Children(3).innerTex bo to chyba klucz do ewentualnej zmiany
Tak czy inaczej wielkie dzięki !!

DwaNiedźwiedzie · Wysłany: 11-12-2017, 17:21

Całe makro opiera się na grzebaniu po drzewku DOM strony - czyli wszedłem na stronę w przeglądarce i w inspektorze dokumentu (ctrl+shift+c w FF, F12 w IE) podejrzałem, co gdzie leży i jak się do tego dobrać. W tym przypadku tabela z albumami nie ma swojego unikatowego ID, trzeba było zatem trochę pokombinować. Pobrałem wszystkie listy (getElementsByTagName("ul")) i wyszukałem tej z odpowiednią klasą (bucket-items ec-bucket filter-page-releases-list, czyli - z grubsza - informacją, jakie wizualne formatowanie ma być zastosowane na elemencie; kolory, położenie itp.).

Podległe pod nią elementy (Children) to już wiersze (li) zawierające informacje, które chciałem pobrać. Część z nich (tych informacji) zaszyta jest w podanych przez Ciebie na początku atrybutach samego wiersza - do nich dotarłem prostą metodą li.Attributes(atrybuty(atr)) (czyli z elementu li pobrałem kolejne atrybuty wymienione w zmiennej atrybuty). Pozostałych danych nie ma w atrybutach, trzeba po nie skoczyć bezpośrednio do elementów je przechowujących (kolejnych "dzieci"). No i tu już wybitnie przydaje się przeglądarka i liczenie na palcach :) Np. ta data znajduje się w drugim elemencie div danego wiersza li (Children(1), bo elementy liczy się od zera), następnie w pierwszym div (Children(0)) i ostatecznie w czwartym p (Children(3)). Jak już mamy ten element, to pobieramy jego zawartość tekstową (innerText) i tyle :)

fafas · Forumowicz Posty: 15

Znalazłem poważny problem ... przykład:
Artystów skrypt pobiera z atrybutu data-ec-d1="Shifterjaxx, Dharstarr, Annzy, Julian Morde, Firebizzare" <-- tak wiem sam podsunąłem ten atrybut :(
natomiast cały album w rozpatrywanym przykładzie: R3sizze Back Catalog, Vol. 5 posiada następującą ilość wykonawców:

Kod:

<p class="buk-horz-release-title"><a href="/release/r3sizze-back-catalog-vol-5/2152430">R3sizze Back Catalog, Vol. 5</a></p>
<p class="buk-horz-release-artists">
<a href="/artist/shifterjaxx/518308" data-artist="518308">Shifterjaxx</a>,
<a href="/artist/dharstarr/562419" data-artist="562419">Dharstarr</a>,
<a href="/artist/annzy/479982" data-artist="479982">Annzy</a>,
<a href="/artist/julian-morde/433303" data-artist="433303">Julian Morde</a>,
<a href="/artist/firebizzare/523034" data-artist="523034">Firebizzare</a>,
<a href="/artist/dyronde/452036" data-artist="452036">Dyronde</a>,
<a href="/artist/definita-lorensa/560356" data-artist="560356">Definita Lorensa</a>,
<a href="/artist/martjin-haaster/522368" data-artist="522368">Martjin Haaster</a>,
<a href="/artist/ralverro-daboss/565130" data-artist="565130">Ralverro Daboss</a>,
<a href="/artist/microsonica/557266" data-artist="557266">Microsonica</a>,
<a href="/artist/ixn/564424" data-artist="564424">IXN</a>,
<a href="/artist/nicci-worxwell/403681" data-artist="403681">Nicci Worxwell</a>,
<a href="/artist/laurin-heldenz/457506" data-artist="457506">Laurin Heldenz</a>,
<a href="/artist/sandro-dellmar/452787" data-artist="452787">Sandro Dellmar</a>,
<a href="/artist/allen-wish/557265" data-artist="557265">Allen Wish</a>,
<a href="/artist/malissa/565835" data-artist="565835">Malissa</a>,
<a href="/artist/darius-harrellson/517702" data-artist="517702">Darius Harrellson</a>,
<a href="/artist/kate-quesza/525599" data-artist="525599">Kate Quesza</a>,
<a href="/artist/neonycatz/479985" data-artist="479985">Neonycatz</a>,
<a href="/artist/felix-boudreau/540921" data-artist="540921">Felix Boudreau</a>,
<a href="/artist/zacc-nash/532461" data-artist="532461">Zacc Nash</a>
</p>

Jak widać w tym atrybucie pokazuje pierwsze 4-5 wykonawców resztę pomija (niestety nie wziąłem tego pod uwagę). Jest szansa naprawić ten błąd? wszystkich artystów może oddawać w jednej komórce, a za separator może służyć , (tak jak było to do tej pory). Obecnie do dzielenia artystów używam poniższej formuły:

Kod:

=USUŃ.ZBĘDNE.ODSTĘPY(FRAGMENT.TEKSTU(PODSTAW(Arkusz1!$A19;",";POWT(" ";DŁ(Arkusz1!$A19)));B$1*DŁ(Arkusz1!$A19)+1;DŁ(Arkusz1!$A19)))

jest dość rozbudowana ale działa poprawnie.
Ponownie z góry dziękuję za pomoc.

Edit: Zefirek
Proszę stosować znaczniki [code] przy wstawianiu kodów makr, kwerend i formuł, Regulamin 3.1

fafas · Forumowicz Posty: 15

Chwila skupienia i można to zrobić samemu :) pomogło twoje objaśnienie:
oto kod:

Kod:

Cells(r, atr + 4) = li.Children(1).Children(0).Children(1).innerText

artyści znajdują się w 2 p :)
Pozdrawiam i dziękuję

fafas · Forumowicz Posty: 15

Dodałem pewne funkcjonalności do kodu:

1. Wprowadziłem "inbox" który zapyta nas jaką ilość stron ma pobrać

Kod:

'zmienna określająca, ile stron chcemy przeszukać
Dim page_number As String 'podajemy liczbe stron
page_number = InputBox("Podaj liczbę stron od 1 do 60")
stron = page_number

2. Wprowadziłem "inbox", w tórym podamy date początkową i końcową:

Kod:

'ustawiamy adres z kolejną liczbą
Dim UrlfName As String 'ustawiamy date poczatkowa
UrlfName = InputBox("Wprowadź date poczatkowa np. 2017-12-01")
Dim UrllName As String 'ustawiamy date koncowa
UrllName = InputBox("Wprowadź date koncowa np. 2017-12-01")
myURL = "https://www.beatport.com/releases/all?per-page=150&start-date=" & UrlfName & "&end-date=" & UrllName & "&page=" & i

Ad. 2 Niestety przy wprowadzeniu dwóch i więcej podstron, do każdej następnej podstrony skrypt poprosi nas o wprowadzenie daty od nowa. Oczywiście po wprowadzeniu np. 3 razy daty początkowej i końcowej wyniki wyświetlają się poprawnie, ale zaciągnięcie np 20 podstron robi się kłopotliwe. Istnieje jakieś proste rozwiązanie problemu ?

DwaNiedźwiedzie · Wysłany: 12-12-2017, 16:13

1) Niepotrzebnie przepisujesz swoją zmienną do mojej, podmień po prostu w reszcie kodu stron na page_number. W deklaracji zmień typ swojej na Integer, w końcu chcesz jej używać do liczenia :)
2) Wyrzuć zapytania o daty i definicję dla myURL (z pominięciem "& i") przed pętlę For. W samej pętli usuń myURL = ..., a numer strony dopisz bezpośrednio w żądaniu:

Kod:

XMLObj.Open "GET", myURL & i, False

fafas · Forumowicz Posty: 15

Oczywiście działa...
Dziękuję.

fafas · Forumowicz Posty: 15

Dzień dobry, a raczej witam ponownie. Chciał bym odświeżyć wątek. Od już dość dawana testuje/użytkuje z powodzeniem przedmiotowe makro. Po tym czasie zauważyłem brak jednej z funkcjonalności. Otóż każdy z singli/albumów posiada swój numer, jest to seria unikatowych liczb i cyfr. Niestety nie można go wydobyć na „podstawowej” (tej wskazanej w kodzie) stronie, jest on dostępny na podstronie danego albumu/singla i tu jest problem. Na wprost: w kodzie strony jest odwołanie do podstrony na której znajduje się nr katalogowy. I potrzebuje go wczytać po już zaciągniętych danych i tak:
Obecny kod:

Kod:

Sub BeatPort()
Set HTMLDoc = CreateObject("HTMLfile")
Set XMLObj = CreateObject("MSXML2.XMLHTTP")

'czyścimy arkusz
ActiveSheet.UsedRange.Clear

'zmienna określająca, ile stron chcemy przeszukać
Dim page_number As Integer 'podajemy liczbe stron
page_number = InputBox("Podaj liczbę stron od 1 do 60")

'wiersz, od którego zaczynamy dopisywać
r = 2

'podajemy atrybuty elementu "LI" ze strony (wiersza z albumem), które chcemy pobrać
'listę można modyfikować: dodawać i usuwać elementy oraz zmieniać ich kolejność
atrybuty = Array("data-ec-name", "data-ec-brand", "data-ec-d3", "data-ec-d2", "data-ec-d1")
'wstawiamy wiersz nagłówka z nazwami atrybutów
Range("a1").Resize(1, UBound(atrybuty) + 1) = atrybuty
'dodajemy dwie osobne kolumny dla okładki i "ekskluzywa", które pobierane są w inny sposób (szczegóły niżej)
Range("a1").Offset(0, UBound(atrybuty) + 1).Resize(1, 4) = Array("link", "ex", "Data", "Artist")

Dim UrlfName As String 'ustawiamy date poczatkowa
UrlfName = InputBox("Wprowadź date poczatkowa np. 2017-12-01")
Dim UrllName As String 'ustawiamy date koncowa
UrllName = InputBox("Wprowadź date koncowa np. 2017-12-01")

'przechodzimy przez wybrany zakres numerów
For I = 1 To page_number
'ustawiamy adres z kolejną liczbą

myURL = "https://www.beatport.com/releases/all?preorders=mixed&start-date=" & UrlfName & "&end-date=" & UrllName & "&page=" & I

'wysyłamy żądanie do serwera
XMLObj.Open "GET", myURL, False
XMLObj.Send

'przerzucamy odpowiedź do obiektu HTML dla łatwiejszego poruszania się po pobranej stronie
HTMLDoc.body.innerhtml = XMLObj.responseText

'wyszukujemy listy na stronie
Set ul = HTMLDoc.getElementsByTagName("ul")

'przeszukujemy te listy w poszukiwaniu tej z właściwą klasą
For Each ul In HTMLDoc.getElementsByTagName("ul")
'sprawdzamy klasę
If ul.classname = "bucket-items ec-bucket filter-page-releases-list" Then
'pobieramy kolejne wiersze listy
For Each li In ul.getElementsByTagName("li")
'wyłączamy obsługę błędów na potrzeby preorderów i exów (nie zawsze występują)
On Error Resume Next
'pobieramy wcześniej zdefiniowane atrybuty do kolejnych komórek
For atr = 0 To UBound(atrybuty)
Cells(r, atr + 1) = li.Attributes(atrybuty(atr)).Value
Next

'link do okładki i exy pobieramy nie z atrybutów całego wiersza, ale z elementów podrzędnych
With li.Children(0).Children(0)
'link z obrazka
Cells(r, atr + 1) = .Children(0).Attributes("data-src").Value
'ex z elementu sąsiadującego z obrazkiem
Cells(r, atr + 2) = .Children(1).innerText
End With
Cells(r, atr + 3) = li.Children(1).Children(0).Children(3).innerText
Cells(r, atr + 4) = li.Children(1).Children(0).Children(1).innerText
'przywracamy obsługę błędów
On Error GoTo 0

'zwiększamy numer wiersza
r = r + 1
Next
'wychodzimy z pętli wewnętrznej, w której szukaliśmy klasy
'ponieważ właściwy element został znaleziony
Exit For
End If
Next

'wrzucamy informację o postępie do paska stanu
Application.StatusBar = "Zaciągniętych stron: " & I & " z " & page_number
Next

'resetujemy pasek stanu

Szukane dane:
W źródle strony: view-source:https://www.beatport.com/releases/all?preorders=mixed
Poniżej sczytanych danych znajduje się kod źródłowy w którym znajduje się odwołanie do podstrony (a raczej jego końcówka) która powinna być poprzedzona początkiem adresu https://www.beatport.com

Kod:

</a>
</div>
<div class="horz-release-meta-parent">
<div class="horz-release-meta">

<p class="buk-horz-release-title"><a href="/release/sumerian-haze/2349626">Sumerian Haze</a></p>
<p class="buk-horz-release-artists">

Czyli całość wychodzi https://www.beatport.com/...an-haze/2349626
Z adresu podstrony interesuje mnie sczytanie w tym przykładzie nr katalogowego BQ315.

DwaNiedźwiedzie · Wysłany: 04-03-2019, 09:52

Na początku procedury dopisz Set HTMLDocCat = CreateObject("HTMLfile"), a poniższy kod wklej przed komentarzem "przywracamy obsługę błędów":

Kod:

lnk = "https://www.beatport.com" & Replace(li.Children(0).Children(0).href, "about:", "")

XMLObj.Open "GET", lnk, False
XMLObj.Send

HTMLDocCat.body.innerhtml = XMLObj.responseText

Set cat = HTMLDocCat.getElementById("pjax-target").getElementsByTagName("ul")(0)
Cells(r, atr + 5).Value = cat.Children(2).Children(1).innerText