Prikazi cijelu temu 04.02.2020 13:38
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Lokacija:zagreb


Predmet:skidanje html table u excel
htio bi skinuti html tablu sa web stranice. Ovaj kod radi kada ide samo jednom, no kada zelim dodati drugi link i nastaviti skidati table onda stane

radi se o spisku pjesama sa web stranice regionalnog radija

evo i kod ako netko ne zeli skidati excel datoteku ili ako netko vizuelno moze da rijesi problem:

PreuzmiIzvorni kôd (Text):
  1. Sub HTML_Table_To_Excel()
  2.  
  3.     Dim htm As Object
  4.     Dim tr As Object
  5.     Dim td As Object
  6.     Dim Tab1 As Object
  7.    
  8.     Column_Num_To_Start = 1
  9.     iRow = 2
  10.     iCol = Column_Num_To_Start
  11.     iTable = 0
  12.    
  13.     '1-31
  14. For dan = 1 To 31 'bez ovoga radi
  15.    
  16.     'Replace the URL of the webpage that you want to download
  17.     'Web_URL = "https://radio.hrt.hr/drugi-program/sto-svira/2020/1/8/"
  18.     Web_URL = "https://radio.hrt.hr/drugi-program/sto-svira/2020/1/" & dan & "/"
  19.    
  20.    
  21.     'Create HTMLFile Object
  22.     Set HTML_Content = CreateObject("htmlfile")
  23.  
  24.     'Get the WebPage Content to HTMLFile Object
  25.     With CreateObject("msxml2.xmlhttp")
  26.         .Open "GET", Web_URL, False
  27.         .send
  28.         HTML_Content.body.innerHTML = .responseText 'this is the highlighted part for the error
  29.     End With
  30.  
  31.    
  32.  
  33.     'Loop Through Each Table and Download it to Excel in Proper Format
  34.     For Each Tab1 In HTML_Content.GetElementsByTagName("table")
  35.         With HTML_Content.GetElementsByTagName("table")(iTable)
  36.             For Each tr In .Rows
  37.                 For Each td In tr.Cells
  38.                     Sheets(1).Cells(iRow, iCol).Select
  39.                     Sheets(1).Cells(iRow, iCol) = td.innertext
  40.                     iCol = iCol + 1
  41.                 Next td
  42.                 iCol = Column_Num_To_Start
  43.                 iRow = iRow + 1
  44.             Next tr
  45.         End With
  46.  
  47.         iTable = iTable + 1
  48.         iCol = Column_Num_To_Start
  49.         iRow = iRow + 1
  50.     Next Tab1
  51.    
  52.     Set htm = Nothing
  53.     Set tr = Nothing
  54.     Set td = Nothing
  55.     Set Tab1 = Nothing
  56.    
  57. Next dan 'izbrisati ako ne zelimo petlju
  58.  
  59.     MsgBox "gotovo"
  60. End Sub


Prilozi:
skidanje liste sta je sviralo.zip
Preuzimanja:285
Velicina datoteke:14.50 KB


zivot je moja domovina.