Pobranie do arkusza danych z plików tekstowych
by vbatools on Dec.20, 2011, under Excel, Porady
Przypuśćmy że mamy listę plików tekstowych, każdy z nich różni się od siebie nazwą i zawartością. Chcielibyśmy przenieść ich zawartość w uszeregowaną grupę danych do arkusza Excela. Otwieranie każdego pliku i kopiowanie jego zawartości troszkę będzie kłopotliwe w przypadku gdy powiadamy znaczną ilość rozpatrywanych plików. Możemy przyjąć też iż nie wszystkie z plików będą brane pod uwagę – np. tylko te, które mają w nazwie element wyróżniający (może to być inny wyróżnik, lub nie musi on być w cale). Przyjmijmy jednak że pliki jakie chcemy analizować będą miały w nazwie dwie litery “PL”. Posłuży nam do tego możliwość zastosowania późnego wiązania kontrolki FSO, która jest ogólnie dostępna w większości systemów MS.
Postać pliku tekstowego to kilka linijek, np:
Nazwa prowadzącego: Nowak Adam Data pomiaru: 2011-01-03 Liczba próbek: 6 Łączny czas trwania 5:21 Maszyna nr: 2
Lista danych w pliku tekstowym oraz wielkość pliku może być dowolna ponieważ będziemy analizować każdą linię pliku. Załóżmy że w zadaniu chcemy pobrać tylko cześć z tych danych (lub wszystkie zależy od ilości warunków). Pobrane dane możemy na etapie przypisania do komórek dowolnie modulować używając funkcji wew VB6 lub własnych. Ilość i czas zapisu danych jest proporcjonalny, a dla większej ilości plików można dodać komunikat w StatusBar’ze o postępującym działaniu. Uruchomienie poniższego kodu pobiera dane i począwszy od wpisania w aktywny arkusz nagłówka będzie osadzał dane w kolejnych wierszach:
Sub import_danych_z_TXT() 'MVP OShon from VBATools.pl Const sciezka As String = "c:\Temp" 'ścieżka z której będą brane pliki - zmodyfikuj With Cells(1, 1) .Value = "Data pomiaru" .Offset(, 1) = "Maszyna" .Offset(, 2) = "Czas trwania" End With Dim objFSO As Object Dim objFolder As Object Dim ObjPlik As Object Dim pobrany$, x&: x = 2 Dim F%: F = FreeFile() Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(sciezka) For Each ObjPlik In objFolder.Files If ObjPlik.Name Like "*PL*" Then 'Ograniczenie - jakie pliki będą brane pod uwagę Open sciezka & ObjPlik.Name For Input As #F Do While Not EOF(F) Line Input #F, pobrany 'Analizujemy konkretne linie i przypisujemy je do celi If InStr(1, pobrany, "Data pomiaru:") > 0 Then _ Cells(x, 1).Value = Application.Trim(Split(pobrany, "Data pomiaru:")(1)) If InStr(1, pobrany, "Maszyna nr:") > 0 Then _ Cells(x, 2).Value = Application.Trim(Split(pobrany, "Maszyna nr:")(1)) If InStr(1, pobrany, "Łączny czas trwania") > 0 Then _ Cells(x, 3).Value = Application.Trim(Split(pobrany, "Łączny czas trwania")(1)) Loop Close #F x = x + 1 End If Next Application.ScreenUpdating = True Set objFSO = Nothing Set objFolder = Nothing Set ObjPlik = Nothing End Sub
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.