Centar za edukaciju-BiH



#1 04.02.2020 13:38
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,696


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:
Informacije o tipu datoteke za:zip  skidanje liste sta je sviralo.zip
Preuzimanja:285
Velicina datoteke:14.50 KB


zivot je moja domovina.
↑  ↓

#2 07.02.2020 00:59
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,611


Predmet:Re: skidanje html table u excel
PreuzmiIzvorni kôd (Visual Basic):
  1. Function 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 = 1
  10.     iCol = Column_Num_To_Start
  11.     iTable = 0
  12.    
  13.     '1-31
  14. For dan = 1 To 31
  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.     ''''''' ovo ti treba samo u slucaju daimasvise tabela
  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
  58.  
  59.     MsgBox "gotovo"
  60. End Function

Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#3 07.02.2020 01:01
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,611


Predmet:Re: skidanje html table u excel
nije ti dobranitipetljaza dane nema svaki mjesec 31dan
trebaspetlju zatekucinjesec ili opciju da biras mjesec
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#4 11.02.2020 09:11
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,611


Predmet:Re: skidanje html table u excel
sta bi sa ovim?
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#5 11.02.2020 20:23
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,696


Predmet:Re: skidanje html table u excel
trenutno problemi sa racunalom pa je u fazi cekanja
zivot je moja domovina.
↑  ↓

Stranice (1):1


Sva vremena su GMT +01:00. Trenutno vrijeme: 12: 12 pm.