VBATools

Pobranie do arkusza danych z plików tekstowych

by 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.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała