Połączenie możliwości obiektów Microsoft.xmlHTTP i MSXML2.DOMDocument do importu wybornych danych z plików xml umieszczonych w sieci - na przykładzie kursów walut NBP.   strona główna:
A po co ten Excel ;-)
 
 
 
    Masa najróżniejszych firm udostępnia w sieci najróżniejsze dane w postaci drzew xml'owych. A jak pokazał mój poprzedni temat   
wykorzystanie xPath do wyciągania z takich plików wybranych przez nas danych nie jest takie trudne :-) Jak wykorzystać więc  
połączenie Microsoft.xmlHTTP i MSXML2.DOMDocument i xPath do pobierania innych danych.. np.: Kursów walut NBP?? :-)  
 
    wiem.. Kursami walut zajmował się już chyba każdy ;-) ale jakoś nigdy nie sprawdzałem jak to robią inni.. Sam do tej pory   
pobierałem te dane raczej wprost ze stronki NBP czy jakiegoś banku funkcją TabelaHTML. Ale to podejście jest inne :-)   Dane z tabeli HTML do tablicy
 
a więc.. Kursy walut NBP :-)
  Archiwalne kursy walut (NBP)
pod każdą tabelą mamy link:  
  Tabela nr 230/A/NBP/2013 z dnia 2013-11-28
 
 
 
a pod linkiem:
 
 
 
 
 
 
 
 
 
 
 
 
a z tego czytać to już umiemy ;-)  
 
Napisze wieć funkcję którą będę mógł używać jako arkuszową a która zwróci tablicę z danymi z tego xml'a.  
 
Option Explicit  
        
Function KursNBP(ByVal dData As Date, Optional strKod As String = "a") As Variant  
    On Error GoTo KursNBP_Error  
    Dim msXML As Object  
    Dim strURL As String  
    Dim tbl() As String, i As Integer: i = 1  
      
    strURL = "http://www.nbp.pl/kursy/xml/" & NrTabeli(strKod, dData) & ".xml"  
    Const xPath As String = "//tabela_kursow/pozycja"  
      
    Dim xmlDoc As Object 'MSXML2.DOMDocument  
    Dim oRoot As Object 'MSXML2.IXMLDOMNode  
    Dim colNodes As Object 'MSXML2.IXMLDOMNodeList  
    Dim oNode As Object 'MSXML2.IXMLDOMNode  
                              
    Set msXML = CreateObject("Microsoft.xmlHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
    End With  
      
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")  
    With xmlDoc  
        .LoadXML msXML.responseXML.XML  
        Set oRoot = .DocumentElement  
        Set colNodes = oRoot.SelectNodes(xPath)  
        ReDim tbl(1 To colNodes.Length, 1 To IIf(strKod = "c", 5, 4))  
                  
        For Each oNode In colNodes  
            tbl(i, 1) = oNode.ChildNodes(0).nodeTypedValue  
            tbl(i, 2) = oNode.ChildNodes(1).nodeTypedValue  
            tbl(i, 3) = oNode.ChildNodes(2).nodeTypedValue  
            tbl(i, 4) = oNode.ChildNodes(3).nodeTypedValue  
            If strKod = "c" Then  
                tbl(i, 5) = oNode.ChildNodes(4).nodeTypedValue  
            End If  
            i = i + 1  
        Next  
    End With  
    KursNBP = tbl  
              
KursNBP_Exit:  
    Set oNode = Nothing  
    Set colNodes = Nothing  
    Set xmlDoc = Nothing  
    Set oRoot = Nothing  
    Set msXML = Nothing  
    Exit Function  
      
KursNBP_Error:  
    'MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Error$, vbExclamation, "VBAProject - KursNBP"  
    Resume KursNBP_Exit  
      
End Function  
 
Function NrTabeli(strTyp As String, dData As Date) As String  
    Dim msXML As Object, strTxt As String  
    Dim arr, i As Long  
 
    Set msXML = CreateObject("Microsoft.xmlHTTP")  
    With msXML  
        .Open "GET", "http://www.nbp.pl/kursy/xml/dir.txt", False   /kursy/xml/dir.txt
        .send  
        strTxt = .responseText  
    End With  
    Set msXML = Nothing  
      
    arr = Split(strTxt, vbNewLine)  
    For i = LBound(arr) To UBound(arr)  
        If arr(i) Like strTyp & "*" & Format(dData, "yymmdd") Then  
            NrTabeli = arr(i)  
            Exit For  
        End If  
    Next  
End Function  
 
W efekcie formuła wprowadzona tablicowo zwraca:  
 
  Function DefPozaTbl
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
a jaki będzie kurs średni NBP euro z wczoraj? :-)  
 
 
 
 
  przykład do pobrania..
  kursy Walut NBP.xls
 
 
 
 
 
 
więc.. Jak zastanawiacie się jak z pliku xml pobrać jakieś dane do Waszego arkusza pomyślcie o xPath :-D