Извлеките одну строку данных из многочисленных текстовых файлов и импортируйте в Excel


У меня есть сотни текстовых файлов в папке, и мне нужно извлечь одну строку из каждого и поместить информацию в excel. Текстовые файлы содержат все метаданные для отдельных фотографий, и мне нужно взять только координаты GPS.

Я просмотрел различные другие подобные темы, например: извлечение данных из нескольких текстовых файлов в папке excel рабочий лист

И:

Http://www.mrexcel.com/forum/excel-questions/531515-visual-basic-applications-retrieve-data-text-file.html (извините, не stackoverflow!)

И многие другие,но не могу заставить его работать. Я близко, но не совсем там.

Данные в каждом из текстовых файлов представлены следующим образом:

...

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

...

Я написал следующий код:

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

Похоже, что он открывает каждый из текстовых файлов и смотрит через них, но только извлекает GPS-координаты из первого файла и повторно помещает это в excel, так что я в конечном итоге с сотнями строк, заполненных теми же данными - GPS-координаты из первого файла в папке.

Если кто-нибудь может помочь мне закончить этот последний кусочек, я буду очень признателен!

Спасибо

1 3

1 ответ:

Вы должны сбросить свой text в противном случае содержимое второго файла добавляется и не заменяется, и поиск всегда находит первые данные GPS и прекращает поиск:

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:\Temp\Test\"
    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