Pomoc pri programovaní, odpovede na otázky / vynikať / Scrape konkrétna položka z webu s VBA - Excel, VBA, hypertextový odkaz, web-škrabanie, webové stránky

Štepiť konkrétnu položku z webovej stránky s VBA - excel, vba, hypertextový odkaz, web-škrabanie, webové stránky

    <tr class="chartsheader">
<td nowrap>PROJECT</td>
<td nowrap>ARTIST/TITLE/LABEL</td>
<td nowrap>TW</td>
<td nowrap>LW</td>
<td nowrap>ADDS</td>
<td nowrap>DROPS</td>
<td nowrap>SPINS</td>
<td nowrap>TREND</td>
<td nowrap>REPORTS</td>
<td nowrap>WEEKS</td>
</tr>

<tr  class="chart_row_bg_1">

<td width="101">
<a href="http://nathaneast.com" target="_blank"><img class="cover" src="/images//images/cd_covers/nathan_east_reverence.jpg" alt="Reverence" width="75" height="75"></a>


<a href="http://rads.stackoverflow.com/amzn/click/B01NBAZEVW" target="_blank"><img class="buybutton" src="/images//images/buttons_amazon.png" alt="Buy Album" width="20" height="20"></a>



<a href="https://geo.itunes.apple.com/us/album/reverence/id1188441346?mt=1&amp;app=music&amp;at=10l4HY" target="_blank"><img class="buybutton" src="/images//images/buttons_itunes.png" alt="Download Album" width="20" height="20"></a>


</td>
<td width="159">
NATHAN EAST
<br>
<em>Reverence</em>
<br>
Yamaha Entertainment Group
</td>
<td align="center">
1
</td>
<td align="center">
1
</td>
<td align="center">
2
</td>
<td align="center">
0
</td>
<td align="center">
556
</td>
<td align="center">
-30
</td>
<td align="center">
<a href="votesbytrack.php?trackingid=MzczOUExMjk3" style="text-decoration:underline">41</a>
</td>
<td align="center">
34
</td>
</tr>
<tr  class="chart_row_bg_2">

<td width="101">
<a href="http://www.rickbraun.com" target="_blank"><img class="cover" src="/images//images/cd_covers/rick_braun_around_the.jpg" alt="Around The Horn" width="75" height="75"></a>


<a href="http://rads.stackoverflow.com/amzn/click/B01N1UDA59" target="_blank"><img class="buybutton" src="/images//images/buttons_amazon.png" alt="Buy Album" width="20" height="20"></a>



<a href="https://geo.itunes.apple.com/us/album/around-the-horn/id1195669636?app=itunes&amp;at=10l4HY" target="_blank"><img class="buybutton" src="/images//images/buttons_itunes.png" alt="Download Album" width="20" height="20"></a>


</td>
<td width="159">
RICK BRAUN
<br>
<em>Around The Horn</em>
<br>
Shanachie Entertainment
</td>
<td align="center">
2
</td>
<td align="center">
2
</td>
<td align="center">
5
</td>
<td align="center">
0
</td>
<td align="center">
478
</td>
<td align="center">
-12
</td>
<td align="center">
<a href="votesbytrack.php?trackingid=MzgxNUExMjk3" style="text-decoration:underline">43</a>
</td>
<td align="center">
19
</td>
</tr>
<tr  class="chart_row_bg_1">

<td width="101">
<a href="http://www.normanbrown.com" target="_blank"><img class="cover" src="/images//images/cd_covers/norman_brown_let_it.jpg" alt="Let It Go" width="75" height="75"></a>


<a href="http://rads.stackoverflow.com/amzn/click/B01LZS6RWZ" target="_blank"><img class="buybutton" src="/images//images/buttons_amazon.png" alt="Buy Album" width="20" height="20"></a>



<a href="https://geo.itunes.apple.com/us/album/let-it-go/id1212482814?app=itunes&amp;at=10l4HY" target="_blank"><img class="buybutton" src="/images//images/buttons_itunes.png" alt="Download Album" width="20" height="20"></a>


</td>
<td width="159">
NORMAN BROWN
<br>
<em>Let It Go</em>
<br>
Shanachie Entertainment
</td>
<td align="center">
3
</td>
<td align="center">
4
</td>
<td align="center">
1
</td>
<td align="center">
0
</td>
<td align="center">
463
</td>
<td align="center">
-9
</td>
<td align="center">
<a href="votesbytrack.php?trackingid=Mzg1NUExMjk3" style="text-decoration:underline">35</a>
</td>
<td align="center">
12
</td>
</tr>

Potrebujem zoškrabať iba hodnoty href s tým, že v ňom bude „hlasybytrack“. Pokúsil som sa vytiahnuť všetky odkazy z tohto webu:

Set my_data = IE.Document.getElementsByClassName("chartstable")
Dim link
i = 1
For Each elem In my_data
Set link = elem.getElementsByTagName("a")(0)
i = i + 1

"copy the data to the excel sheet
ActiveSheet.Cells(i, 4).Value = link.href
ActiveSheet.Cells(i, 2).Value = link.innerText
Next

Ale dostanem len:

http://nathaneast.com http://www.amazon.com/exec/obidos/ASIN/B01NBAZEVW/smoothcominc-20/104-7130076-1428709?%5Fencoding=UTF8&camp=1789&link%5Fcode=xm2

a tak ďalej ... ale bez akéhokoľvek prepojenia potrebujem (v ňom „hlasybytrack“ ...)

odpovede:

0 pre odpoveď č. 1

Set httpObject2 = CreateObject("InternetExplorer.Application")

For NEXTlink0 = 1 To 1000
nextLINK = "https://legacy.smoothjazz.com/charts/votesbytrack.php?trackingid=" & InputBox("Please enter full code for artist you want to download! If there is no more records, leave blank.")
If nextLINK = "https://legacy.smoothjazz.com/charts/votesbytrack.php?trackingid=" Then GoTo finishLOOP

"ARTIST NAME
With httpObject2
.navigate nextLINK
.Visible = False
Do Until httpObject2.readyState = 4
DoEvents
Loop
.Visible = False
End With

Set doc2 = httpObject2
Set elem2 = doc2.Document.getElementsByClassName("trackingartistname")
For Each L2 In elem2
Sheets("HEADER TEMP").Cells(X, 1).Value = L2.innerText
X = X + 1
Next L2

"ALBUM NAME
Set elem3 = doc2.Document.getElementsByClassName("trackingalbumname")
For Each L3 In elem3
Sheets("ALBUM TEMP").Cells(Y, 1).Value = L3.innerText
Y = Y + 1
Next L3

"TABLE NAME
Sheets("CHART TEMP").Select
Cells.Select
Selection.ClearContents
Set doc4 = httpObject2.Document
Set TABLES = doc4.getElementsByTagName("TABLE")
Set Table = TABLES(1)
"
Set clipboard = New MSForms.DataObject
clipboard.SetText Table.outerHTML
clipboard.PutInClipboard
Sheets("CHART TEMP").Range("A1").Select
Selection.PasteSpecial
fcTABLE = 1
lcTABLE = Sheets("CHART TEMP").Cells(1, Sheets("CHART TEMP").Columns.Count).End(xlToLeft).Column
frTABLE = 1
lrTABLE = Sheets("CHART TEMP").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("CHART TEMP").Range(Cells(frTABLE, fcTABLE),
Cells(lrTABLE,lcTABLE)).Copy
pasteTABLE = Sheets("IMPORT TEMPLATE").Cells(Rows.Count,
"C").End(xlUp).Row
Sheets("IMPORT TEMPLATE").Range("C" & pasteTABLE + 1).PasteSpecial
xlPasteValues
Set clipboard = Nothing

"ADD ARTIST ALBUM TO IMPORT TEMPLATE NEXT TO APPROPRIATE CHART
Sheets("IMPORT TEMPLATE").Activate
lrIMPORTC = Sheets("IMPORT TEMPLATE").Cells(Rows.Count, "C").End(xlUp).Row
N = Sheets("IMPORT TEMPLATE").Cells(Rows.Count, "B").End(xlUp).Row
For addARTALB = (N + 1) To lrIMPORTC
Cells(addARTALB, 2).Value = Trim(Sheets("HEADER TEMP").Cells(M, 1).Value) & " -
" & Trim(Sheets("ALBUM TEMP").Cells(M, 1).Value)
Next addARTALB
ARTISTx = Sheets("IMPORT TEMPLATE").Cells(addARTALB, 2).Value

MsgBox ("Importing " & ARTISTx & " finished!")
M = M + 1

Next NEXTlink0

Viem, že to vyzerá ako Frankenstein, ale vyriešil to môj problém!