从众多文本文件中提取单行数据并导入Excel

Question

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

Answer 1

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