Extrahovať jeden riadok dát z mnohých textových súborov a importovať do Excelu - Excel, Excel-VBA, VBA

Mám stovky textových súborov v priečinku a jaje potrebné extrahovať jeden riadok z každého z nich a dať informácie do Excelu. Textové súbory obsahujú všetky metaúdaje pre jednotlivé fotografie a musím zobrať len súradnice GPS.

Pozrel som sa cez rôzne iné podobné témy, napr. extrahovať dáta z viacerých textových súborov v priečinku do pracovného hárka programu Excel

a:

http://www.mrexcel.com/forum/excel-questions/531515-visual-basic-applications-retrieve-data-text-file.html (Prepáč, nie stackoverflow!)

a mnohí iní, ale dokážu ho „dostať do práce.“ Som blízko, ale nie celkom tam.

Údaje v každom z textových súborov sú nastavené takto:

...

---- Composite ----
Aperture                        : 3.8
GPS Altitude                    : 37.2 m Above Sea Level
GPS Date/Time                   : 2014:05:15 10:30:55.7Z
GPS Latitude                    : 50 deg 7" 33.40" N
GPS Longitude                   : 5 deg 30" 4.06" W
GPS Position                    : 50 deg 7" 33.40" N, 5 deg 30" 4.06" W
Image Size                      : 4608x3456

...

Napísal som nasledujúci kód:

Sub ExtractGPS()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, posGPS As String

MyFolder = "C:UsersDesktopTest"
MyFile = Dir(MyFolder & "*.txt")

Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop

Close #1
MyFile = Dir()
posGPS = InStr(text, "GPS Position")
nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row + 1
Sheet1.Cells(nextrow, "A").Value = Mid(text, posGPS + 33, 37)
Loop
End Sub

Zdá sa, že sa otvoria všetky textové súbory apozerať sa cez ne, ale iba vyberá súradnice GPS z prvého súboru a opakovane ich vloží do programu Excel, takže skončím so stovkami riadkov vyplnených rovnakými údajmi - súradnicami GPS z prvého súboru v priečinku.

Ak mi niekto môže pomôcť dokončiť tento posledný kúsok, bolo by to veľmi ocenené!

Vďaka

odpovede:

Musíte resetovať text v opačnom prípade sa obsah druhého súboru pridá a nenahradí a vyhľadávanie vždy nájde prvé údaje GPS a zastaví vyhľadávanie:

Sub ExtractGPS()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, posGPS As String

MyFolder = "C:TempTest"
MyFile = Dir(MyFolder & "*.txt")

Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline "second loop text is already stored -> see reset text
Loop
Close #1
MyFile = Dir()
Debug.Print text
posGPS = InStr(text, "GPS Position")
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(nextrow, "A").Value = Mid(text, posGPS + 33, 37)
text = "" "reset text
Loop
End Sub