Dane z tabeli HTML do tablicy   strona główna:
A po co ten Excel ;-)
 
Od jakiegoś czasu chciałem napisać uniwersalną procedurę importu danych z tabeli MSHTML.HTMLTable do tablicy i w końcu jest :-)  
Ktoś stwierdzi że przecież prawie to samo można osiągnąć Kwerendą sieci Web jednak moja funkcja ma tę przewagę że dane zwraca  
do tablicy, a następnie można z tymi danymi zrobić co się zechce zanim zwrócimy je (lub ich część) do komórek arkusza.  
Załóżmy że chcielibyśmy codziennie po 17:30 importować dane o przebiegu sesji na GPW. Interesuje nas część, lub całość notowanych  
papierów (lub innych). Tu kwerenda pewnie by wystarczyła jednak nam się marzy żeby dane nt. poszczególnych spółek znalazły się  
w oddzielnych arkuszach. Oddzielny arkusz dla każdej spółki. Jeżeli jakaś spółka jest notowana po raz pierwszy tworzony jest dla niej  
nowy arkusz… :-) mam taką zabawkę (choć tu jedynie przedstawiam główny jej mechanizm) choć sytuacja na giełdzie jakoś mnie   
zniechęciła do importowania nowych danych :-P Jednak całość działa właśnie na podstawie danych z tabeli na GPW.pl importowanej  
do tablicy…  
    Jak więc wygląda funkcja:  
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  
 
Function TabelaHTML(strURL As String, _  
                    Optional lngSleep As Long = 0, _  
                    Optional ItemNr As Integer = 1) As Variant  
                      
    On Error GoTo TabelaHTML_Error  
      
    'Info do wczesnego wiązania:  
    'Referencje do:  
    '   Microsoft HTML Object Library  
    '   Microsoft Internet Controls  
      
    Dim ieApp As Object 'SHDocVw.InternetExplorer  
    Dim ieTables As Object, ieTable As Object 'MSHTML.HTMLTable  
    Dim ieRows As Object, ieRow As Object 'MSHTML.HTMLTableRow  
    Dim ieCells As Object, ieCell As Object 'MSHTML.HTMLTableCell  
      
    Const READYSTATE_COMPLETE = 4  
      
    Dim tbl() As Variant, i As Long, j As Long  
      
    Set ieApp = CreateObject("InternetExplorer.Application")  
    With ieApp  
        .navigate URL:=strURL  
        Do Until .readyState = READYSTATE_COMPLETE: Loop  
 
        Sleep lngSleep  
 
        Set ieTables = .document.all.tags("TABLE")  
        Set ieTable = ieTables(ItemNr - 1)  
        Set ieRows = ieTable.Rows  
        For Each ieRow In ieRows  
            i = i + 1  
            Set ieCells = ieRow.Cells  
            For Each ieCell In ieCells  
                j = j + 1  
                If i = 1 And j = 1 Then  
                    ReDim tbl(1 To ieTable.Rows.Length, _  
                              1 To ieRow.Cells.Length)  
                End If  
                If j > UBound(tbl, 2) Then  
                    ReDim Preserve tbl(1 To ieTable.Rows.Length, _  
                                       1 To ieRow.Cells.Length)  
                End If  
                tbl(i, j) = ieCell.innerText  
            Next  
            j = 0  
        Next  
        .Quit  
    End With  
    Set ieApp = Nothing  
      
    TabelaHTML = tbl  
      
TabelaHTML_Exit:  
    On Error Resume Next  
      
    If Not ieApp Is Nothing Then  
        ieApp.Quit  
        Set ieApp = Nothing  
    End If  
      
    Set ieTables = Nothing  
    Set ieRows = Nothing  
    Set ieCells = Nothing  
 
    Exit Function  
        
TabelaHTML_Error:  
     MsgBox "Błąd Nr - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - Wig20zGPW"  
     Resume TabelaHTML_Exit  
 
End Function  
 
Fragmentami:.  
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  
 
Dane importujemy z tabeli jednak część tabel (np. na gpw.pl) jest ładowanych na stronę już po załadowaniu samej strony. Sama więc  
pętla która nie puści procedury dalej dopóki strona się nie załaduje może nie wystarczyć. Stąd potrzeba czegoś co na pewien czas  
wstrzyma działanie procedury dając czas stronie na wypełnienie tabeli którą będziemy później czytać.  
 
    'Info do wczesnego wiązania:  
    'Referencje do:  
    '   Microsoft HTML Object Library  
    '   Microsoft Internet Controls  
 
Zawsze piszę całość na wczesnym wiązaniu a na końcu przerabiam na późne. Postępując w ten sposób mamy dostęp do podpowiedzi  
VBE nt. metod, ich argumentów, stałych… co tu dużo tłumaczyć :-)  
    Te wykomentowane 4'ry linijki wskazują (najczęściej mi - kiedy znów coś zaczynam pisać coś podobnego) z jakich bibliotek  
korzystałem pisząc daną funkcję czy procedurę..  
 
    Set ieApp = CreateObject("InternetExplorer.Application")  
    With ieApp  
        .navigate URL:=strURL  
        Do Until .readyState = READYSTATE_COMPLETE: Loop  
 
        Sleep lngSleep  
 
Tworzymy więc nową, niewidoczną instancję Internet Explorera. Przechodzimy na stronę z naszą tabelą. Czekamy na załadowanie   
strony a następnie dajemy czas stronie na załadowanie tabeli.  
 
        Set ieTables = .document.all.tags("TABLE")  
        Set ieTable = ieTables(ItemNr - 1)  
 
Określamy tabelę z której chcemy importować dane. Nie można do tego wykorzystać ani właściwości .Name, ani ClassName bo nadanie   
takich właściwości dla tabel w HTLM nie jest wymagalne. Odwołamy się więc "jakby" do elementu kolekcji.  
 
        Set ieRows = ieTable.Rows  
        For Each ieRow In ieRows  
            i = i + 1  
            Set ieCells = ieRow.Cells  
            For Each ieCell In ieCells  
                j = j + 1  
 
Czytamy "wiersze" a w nich ich "komórki"  
 
                If i = 1 And j = 1 Then  
                    ReDim tbl(1 To ieTable.Rows.Length, _  
                              1 To ieRow.Cells.Length)  
                End If  
 
i = 1 And j = 1 tzn jeszcze przed przeczytaniem choćby pierwszego elementu tabeli znamy już wymiary tablicy którą zwróci nasza  
funkcja.  
 
                If j > UBound(tbl, 2) Then  
                    ReDim Preserve tbl(1 To ieTable.Rows.Length, _  
                                       1 To ieRow.Cells.Length)  
                End If  
 
Jednak ilość "komórek" w każdym "wierszu" nie musi być stała. Wykorzystując fakt że ilość komórek to drugi (ostatni) wymiar tablicy  
wyników poszerzamy ją jeżeli ilość "komórek" w "wierszu" się zwiększy :-)  
 
                tbl(i, j) = ieCell.innerText  
 
Zapis elementu tabeli HTML do tablicy którą zwróci nasza funkcja.  
 
    If Not ieApp Is Nothing Then  
        ieApp.Quit  
        Set ieApp = Nothing  
    End If  
      
    Set ieTables = Nothing  
    Set ieRows = Nothing  
    Set ieCells = Nothing  
 
W ramach obsługi błędów… Tu (jak zresztą zawsze) jest ona konieczna. Tworzymy niewidoczną instancję IE. Jeżeli z jakiegoś powodu  
doszłoby do błędu a my nie mielibyśmy obsługi błędów w której dojdzie do zamknięcia tego IE proces pozostanie aktywny, a kolejne   
wywołania funkcji tworzyłyby kolejne instancję IE. Itd… do czego przecież dopuścić nie możemy :-)  
 
No to jeszcze pare przykładów tabel które można w ten sposób importować…  
 
Sub DaneZTabeliHTML()  
    Dim xlWks As Excel.Worksheet, tbl As Variant  
      
    Const strURL_GPW As String = "http://www.gpw.pl/akcje_i_pda_notowania_ciagle_pelna_wersja"  
 
    Const DoImportu As String = "All"  
      
    Select Case DoImportu  
 
        Case "WIG20"  
            Const strWig20_GPW As String = "#wig20"  
            tbl = TabelaHTML(strURL_GPW & strWig20_GPW, 3000)  
          
        Case "WIG40"  
            Const strWig40_GPW As String = "#mwig40"  
            tbl = TabelaHTML(strURL_GPW & strWig40_GPW, 3000)  
              
        Case "WIG80"  
            Const strWig80_GPW As String = "#swig80"  
            tbl = TabelaHTML(strURL_GPW & strWig80_GPW, 3000)  
              
        Case "All"  
            Const strAll_GPW As String = "#all"  
            tbl = TabelaHTML(strURL_GPW & strAll_GPW, 8000)  
              
        Case "Index"  
            Const strIndex_GPW As String = "http://www.gpw.pl/indeksy_pelna_wersja#indexes"  
            tbl = TabelaHTML(strIndex_GPW, 1000, 2)  
              
        Case "ETF"  
            Const strETF_GPW As String = "http://www.gpw.pl/etf_pelna_wersja"  
            tbl = TabelaHTML(strETF_GPW, 1000)  
              
        Case "OblSkarbowe"  
            Const strObl_GPW As String = "http://www.gpw.pl/obligacje_skarbowe_pelna_wersja"  
            tbl = TabelaHTML(strObl_GPW, 3000)  
          
        Case "Inne1"  
            Const strURL_ekstraklasa = "http://ekstraklasa.net/ekstraklasa/tabela/"  
            tbl = TabelaHTML(strURL_ekstraklasa)  
              
        Case "Inne2"  
            Const strURL_nbp = "http://www.nbp.pl/kursy/kursya.html"  
            tbl = TabelaHTML(strURL_nbp, , 4)  
    End Select  
      
    If Not IsEmpty(tbl) Then  
        Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
        With xlWks  
            .[A1].CurrentRegion.Clear  
            Tbl2Rng .[A1], tbl  
        End With  
        Set xlWks = Nothing  
    End If  
 
End Sub  
 
Sub Tbl2Rng(rngCell As Excel.Range, tbl As Variant)  
    With rngCell  
        .Resize(UBound(tbl), UBound(tbl, 2)) = tbl  
        .CurrentRegion.Columns.EntireColumn.AutoFit  
    End With  
End Sub  
 
O importowanej tabeli decydujemy określając wartość stałej DoImportu na jedną z wartość w Select Case  
 
    Const DoImportu As String = "All"  
      
    Select Case DoImportu  
        Case "WIG20"  
        Case "WIG40"  
        Case "WIG80"  
        Case "All"  
        Case "Index"  
        Case "ETF"  
        Case "OblSkarbowe"  
        Case "Inne1"  
        Case "Inne2"  
    End Select  
 
Większość przykładów dotyczy danych giełdowych ale Inne1 to tabela ekstraklasy, Inne2 to tabelaA kursów walut Nbp :-)  
Procedurę można więc stosować z powodzeniem dla tabel z różnych źródeł. Zwracam jednak uwagę na opcjonalne argumenty a więc  
zarówno lngSleep (czas na załadowanie tabeli na stronę, już po załadowaniu strony. Podane wartości w milisekundach.) jak i ItemNr  
(numer tabeli na stronie)  
 
    If Not IsEmpty(tbl) Then  
        Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
        With xlWks  
            .[A1].CurrentRegion.Clear  
            Tbl2Rng .[A1], tbl  
        End With  
        Set xlWks = Nothing  
    End If  
 
Jeżeli tablica zostanie utworzona, a więc nie dojdzie do jakiegoś błędu czyszczę komórki docelowe przed wprowadzeniem nowych  
danych i zwracam tablicę wyników do komórek od rngCell procedurą Tbl2Rng  
 
Sub Tbl2Rng(rngCell As Excel.Range, tbl As Variant)  
    With rngCell  
        .Resize(UBound(tbl), UBound(tbl, 2)) = tbl  
        .CurrentRegion.Columns.EntireColumn.AutoFit  
    End With  
End Sub  
 
Tak jak wspomniałem proste zwracanie danych z tablicy do zakresu komórek można by równie dobrze zrobić kwerendą. Te przykłady  
nie przetwarzają w żaden sposób danych zapisanych do tablicy. Jednak zamiast grzebać w komórkach arkusza będących wynikiem  
kwerendy możemy z takimi danymi zrobić co zechcemy to jednak zależy od indywidualnych potrzeb i gustów. To Wam więc zostawiam.