Извлеките одну строку данных из многочисленных текстовых файлов и импортируйте в 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 ответ:
Вы должны сбросить свой
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