Extract a single line of data from numerous text files and import into Excel
I have hundreds of text files in a folder and I need to extract a single line from each one and put the info into excel. The text files contain all the metadata for individual photographs and I need to take out just the GPS coordinates.
I have looked through various other similar threads e.g: extract data from multiple text files in a folder into excel worksheet
and:
http://www.mrexcel.com/forum/excel-questions/531515-visual-basic-applications-retrieve-data-text-file.html (sorry, not stackoverflow!)
and many others, but can't quite get it to work. I'm close but not quite there.
The data in each of the textfiles is set out like this:
...
---- 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
...
I have written the following code:
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:\Users\Desktop\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
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
It appears to open each of the text files and look through them but only extracts the GPS coordinates from the first file and repeatedly puts this in excel so I end up with hundreds of rows filled with the same data - the GPS coordinates from the first file in the folder.
If anyone can help me to finish this last bit off it would be greatly appreciated!
Thanks
You have to reset your text
otherwise the content of the second file is added and not replaced and the search always find the first GPS data and stop searching:
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