Import z nietypowych plików tekstowych  (*.mst)
umożliwiającą porównywanie danych.
  strona główna:
A po co ten Excel ;-)
 
 
     Temat powstał na potrzeby excelforum.pl jednak rozbudowany może (choć w części) się komuś przydać - mi na pewno :-)  
Zadanie polegało na imporcie danych z plików *.mst jednak w sposób umożliwiający porównywanie danych.  
Przykładowy plik *.mst otwarty w notatniku wygląda następująco:  
 
          <TICKER>,<DTYYYYMMDD>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>  
          06MAGNA,19970612,10.60,10.60,10.60,10.60,147925  
          06MAGNA,19970613,11.20,11.20,11.20,11.20,149095  
          06MAGNA,19970616,10.70,10.70,10.70,10.70,68149  
 
A chcielibyśmy mieć dane w postaci --->>  
 
Skomplikujemy jedynie trochę:  
 - nie mamy plików *.mst wiemy jednak skąd z sieci można je  
   pobrać.  
 - ze wszystkich dostępnych tam plików stworzymy listę do  
   ListBox'a w którym będziemy wskazywać z których mają być  
   importowane dane.  
 - import danych ze wskazanych plików już był :-) Tu jedynie  
   wyjaśnię pokrótce procedurę realizującą to zadanie.  
 
 
Nasz katalog z plikami to:  
 
Const strURL As String = "http://zamojski-fes.googlecode.com/svn/trunk/test/"  
 
Zobaczmy tą stronę przeglądająć Źródło…  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Jak zrobić listę (tablicę) z nazwami plików z tych linków?  
 
Sub LadujPliki(ByRef arrLista As Variant)  
    On Error GoTo LadujPliki_Error  
 
    Dim objIEBrowser As Object 'SHDocVw.InternetExplorer  
    Dim objHTMLDoc As Object  'MSHTML.HTMLDocument  
    Dim colTags As Object, objTag As Object  
    Dim vList() As String, i As Integer  
      
    Const READYSTATE_COMPLETE = 4  
 
    Set objIEBrowser = CreateObject("InternetExplorer.Application")  
    With objIEBrowser  
        .navigate strURL  
        '.Visible = True  
        Do  
            DoEvents  
        Loop Until .readyState = READYSTATE_COMPLETE  
        Set objHTMLDoc = .Document  
    End With  
      
    Set colTags = objHTMLDoc.getElementsByTagName("a")  
    Dim TagsCount As Integer: TagsCount = colTags.Length  
    For Each objTag In colTags  
        With objTag  
            If objTag.OuterText Like "*.mst" Then  
                ReDim Preserve vList(i)  
                vList(i) = objTag.OuterText  
                i = i + 1  
                UserForm1.ProgressBar1.Value = Int(i / TagsCount * 100)  
            End If  
        End With  
    Next  
    arrLista = vList  
 
LadujPliki_Exit:  
    If Not objIEBrowser Is Nothing Then objIEBrowser.Quit  
    Set objIEBrowser = Nothing  
    Set objHTMLDoc = Nothing  
    Set colTags = Nothing  
    Set objTag = Nothing  
    Exit Sub  
 
LadujPliki_Error:  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - LadPli"  
    Resume LadujPliki_Exit  
 
End Sub  
 
Choć wystarczyłaby tu funkcja, której wynikiem byłaby tablica z nazwami plików, jednak przyjąłęm wersję Procedury która  
utworzy te tablicę poprzez Referencję. Powodem takiego podejścia jest fakt że chciałem żeby postęp tworzenia tej tablicy by  
odwzorowany na ProgressBar'ze. Więc gdyby to miała być funkcja która zmieniałaby coś "poza tą funkcją" to choćby z czysto  
teoretycznych przyczyn wolałem żeby to była procedura :-)  
    Mając już obiekt objHTMLDoc (MSHTML.HTMLDocument) przeglądam kolejcię Tagów okreslonych metodą getElementsByTagName  
 
    Set colTags = objHTMLDoc.getElementsByTagName("a")  
 
Są to wszystkie linki na stronie. Ile jest tych linków?  
 
    Dim TagsCount As Integer: TagsCount = colTags.Length  
 
Teraz wystarczy:  
 
    For Each objTag In colTags  
        With objTag  
            If objTag.OuterText Like "*.mst" Then  
                ReDim Preserve vList(i)  
                vList(i) = objTag.OuterText  
                i = i + 1  
                UserForm1.ProgressBar1.Value = Int(i / TagsCount * 100)  
            End If  
        End With  
    Next  
    arrLista = vList  
 
i mamy tablicę z nazwami plików z naszego strURL. Tę tablice wstawimy jako List ListBox'a na UserForm'ie.  
    Jest tego MASA ;-). Bo oprócz notowań spółek widze żesą też kontrakty… ważne że trzeba stworzyć jakiś mechanizm który  
ułatwi nam odnalezienie okreslonych spółek.. Zrobiłęm to na TextBox'ie który po BeforeUpdate wskaże nam pierwsze dopasowanie.  
Nie powinno się jednak znalezionego elementu zaznaczać bo z zaznaczonych chcę tworzyć wynikowe porównanie. Wystarczy że   
procedura "wskaże/zaznaczy" pierwsze dopasowanie.  
 
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)  
    Dim i As Integer  
    'Stop  
    With Me.ListBox1  
        For i = 0 To .ListCount - 1  
            If .List(i, 0) Like "*" & UCase(Me.TextBox1.Text) & "*" Then  
                .ListIndex = i  
                Exit For  
            End If  
        Next  
        .SetFocus  
    End With  
End Sub  
 
Po zaznaczeniu już wybranych spółek klikamy na przycisk uruchamiający zasadniczą procedurę.  
 
Private Sub CommandButton1_Click()  
    Dim i As Integer  
    Dim tbl() As Variant, iTbl As Integer  
      
    Me.ProgressBar2.Visible = True  
 
    With Me.ListBox1  
        For i = 0 To .ListCount - 1  
            If .Selected(i) Then  
                ReDim Preserve tbl(iTbl)  
                tbl(iTbl) = .List(i, 0)  
                iTbl = iTbl + 1  
            End If  
        Next  
    End With  
      
    If iTbl > 0 Then TworzDane tbl  
      
    Me.ProgressBar2.Visible = False  
End Sub  
 
Postęp pobierania danych również chciałem pokazać na Pasku Postępu. Przeglądam elementy ListBox'a tworząt tablicę z zaznaczonych  
danych. Jeżeli procedura "uzbiera" >0 klikniętych plików rusza procedura TworzDane. Procedura ta to:  
 
Private Declare Function URLDownloadToFile _  
    Lib "urlmon" _  
    Alias "URLDownloadToFileA" ( _  
        ByVal pCaller As Long, _  
        ByVal szURL As String, _  
        ByVal szFileName As String, _  
        ByVal dwReserved As Long, _  
        ByVal lpfnCB As Long) _  
    As Long  
 
Sub TworzDane(arrSA As Variant)  
    Dim strFolder As String: strFolder = ThisWorkbook.Path & "\"  
    Dim i As Integer  
    Dim iNr As Integer, strLine As String, vWords As Variant  
    Dim iNr2 As Integer  
 
    iNr2 = VBA.FreeFile  
      
    Open ThisWorkbook.Path & "\temp.txt" For Append As #iNr2  
        Print #iNr2, "<TICKER>,<DTYYYYMMDD>,<CLOSE>"  
 
        For i = 0 To UBound(arrSA)  
            iNr = VBA.FreeFile  
              
            URLDownloadToFile 0, strURL & arrSA(i), strFolder & arrSA(i), 0, 0  
              
            Open strFolder & arrSA(i) For Input As #iNr  
                Do While Not EOF(iNr)  
                    Line Input #iNr, strLine  
                    If Not strLine Like "<TICKER>*" Then  
                        vWords = VBA.Split(strLine, ",")  
                        Print #iNr2, vWords(0) & "," & vWords(1) & "," & vWords(5)  
                    End If  
                Loop  
            Close #iNr  
              
            VBA.Kill strFolder & arrSA(i)  
              
            UserForm1.ProgressBar2.Value = Int((i) / UBound(arrSA) * 100)  
              
        Next  
 
    Close #iNr2  
 
      
    Dim strSQL As String: strSQL = "TRANSFORM Sum([<CLOSE>]) " & _  
                                   "SELECT [<DTYYYYMMDD>] " & _  
                                   "FROM [temp.txt] " & _  
                                   "GROUP BY [<DTYYYYMMDD>] " & _  
                                   "PIVOT [<TICKER>];"  
      
    ImportZTXT_ADO [A1], _  
                   ThisWorkbook.Path, _  
                   "temp.txt", _  
                   strSQL, _  
                   "Format = Delimited(,)", _  
                   "DecimalSymbol = .", _  
                   "ColNameHeader = True", _  
                   "DateTimeFormat=yyyymmdd", _  
                   "Col1=<TICKER> Char", _  
                   "Col2=<DTYYYYMMDD> Date Width 8", _  
                   "Col3=<CLOSE> Float "  
      
    VBA.Kill ThisWorkbook.Path & "\temp.txt"  
 
End Sub  
 
Fragmentami:  
 
    iNr2 = VBA.FreeFile  
       Sekwencyjne pliki danych
    Open ThisWorkbook.Path & "\temp.txt" For Append As #iNr2  
        Print #iNr2, "<TICKER>,<DTYYYYMMDD>,<CLOSE>"  
 
Pierwszym zadaniem tej procedury jest utworzenie pliku temp.txt do którego będą zapisywane istotne dane z plików *.mst Zapisuję  
do niego również nagłówki. Mogłyby być dowolne - pozostawiłem takie jak w plikach źródłowych. Zmiana na własne musiałaby być  
uwzględniona w zapytaniu SQL - co jest oczywiste ;-P  
 
        For i = 0 To UBound(arrSA)  
            URLDownloadToFile 0, strURL & arrSA(i), strFolder & arrSA(i), 0, 0  
(..)  
            VBA.Kill strFolder & arrSA(i)  
        Next  
 
 
W pęli po tablicy z nazwami plików do pobrania ściągam te pliki na dysk. A jak już są niepotrzebne to je usuwam.  
 
            iNr = VBA.FreeFile  
            Open strFolder & arrSA(i) For Input As #iNr  
                Do While Not EOF(iNr)  
                    Line Input #iNr, strLine  
                    If Not strLine Like "<TICKER>*" Then  
                        vWords = VBA.Split(strLine, ",")  
                        Print #iNr2, vWords(0) & "," & vWords(1) & "," & vWords(5)  
                    End If  
                Loop  
            Close #iNr  
 
Ściągnięty plik otwieram i istotne fragmenty Linii zapisuję do pliku temp.txt  
W tym pliku znajdą się zatem wszystkie dane ze wszystkich plików *.mst   
Czemu takie podejście?  
 1. Z plików mst nie mogę importować danych poprzez ADO a taki sposób importu uznałem za racjonalny ze względu na ostateczny  
    kształt danych.   
 2. Nawet jak bym mógł importować poprzez ADO z takich plików to trzeba by na nich stworzyć złączenie. Złączenia mają ograniczenie  
    co do ilości łączonych tablic i wiedząc ile plików jest na naszym strURL mogę brać pod uwagę że złączenia mają spore szanse się  
    nie powieźć :-|  
 3. Z takiego pliku txt, w którym są wszystkie dane, cała trudność realizacji zadania to skłądnia zapytania SQL. A to już nie tak dużo.  
 
    Dim strSQL As String: strSQL = "TRANSFORM Sum([<CLOSE>]) " & _  
                                   "SELECT [<DTYYYYMMDD>] " & _  
                                   "FROM [temp.txt] " & _  
                                   "GROUP BY [<DTYYYYMMDD>] " & _   Zwiększanie czytelności danych podsumowania za pomocą kwerendy krzyżowej (ACCESS)
                                   "PIVOT [<TICKER>];"  
 
Takie zapytanie znam raczej z Accessa (kwerenda krzyżowa) i (szczerze) nie miałem pojęciaże to może zadziałać na pliku txt.   
 
    ImportZTXT_ADO [A1], _  
                   ThisWorkbook.Path, _  
                   "temp.txt", _  
                   strSQL, _  
                   "Format = Delimited(,)", _  
                   "DecimalSymbol = .", _  
                   "ColNameHeader = True", _  
                   "DateTimeFormat=yyyymmdd", _  
                   "Col1=<TICKER> Char", _  
                   "Col2=<DTYYYYMMDD> Date Width 8", _  
                   "Col3=<CLOSE> Float "  
  Import danych z pliku TXT ADO
Procedura importująca została jedynie rozbudowana o pokazanie nagłówków kolumn reszta - "stara, dobra…"  
 
Pozostaje jeszcze powiedzieć o ograniczeniach procedury:  
 - ktoś powie że wystarczyłoby zaimportować dane z plików *.mst wprost do arkusza i na ich podstawie utworzyć tabelę przestawną  
   i słusznie ;-) Pierwszym ograniczeniem z którym należałoby się liczyć to ilość wierszy w Arkuszu. W E2003 może nie wystarczyć  
   nawet dla małej ilość plików mst. Danych w nich zawartych jest nieraz dość dużo (dzienne z dni roboczych od 1992r).    
 - ilość kolumn w E2003 też jest dość istotna. Ta procedura też nie jest na to odporna. Choć import > 256 spółek na raz w celu   Przykład można pobrać z:
   porównywania nie koniecznie mogłaby w czymś pomóc, ale nie możemy wykluczyć że ktoś takich danych właśnie nie będzie     
   porezebował. Więc dla informacji - takie "cuda" to dobiero od wersji E2007 lub wymyślić jakiś inny sposób przechowywania danych.   importsa.zip
 - dla E2007/10 ograniczenia te mogą nie być istotne. Choć przyjmując metodę: import danych do arkusza i tabela przestawna, dla   
   wszystkich danych istnieje prawdopodobieństwo że ilość wierszy może być za mała :-D.  
   Jednak importu poprzez temp.txt nie dotyczy to ograniczenie więc, w zasadzie, dla E2007/10 opisaną tu metodą można stosować    
   nie zastanawiając się nad ilością miejsca w arkuszu.