Question

我在一个文件夹中有数百个文本文件，我需要从每个文件夹中提取一行并将信息放入excel。文本文件包含单个照片的所有元数据，我只需要取出GPS坐标。

我查看过各种其他类似的主题，例如：extract data from multiple text files in a folder into excel worksheet

和

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

它似乎打开每个文本文件并查看它们但只从第一个文件中提取GPS坐标并重复将其放入excel中，因此我最终得到了数百行充满相同数据的行 - 来自的GPS坐标文件夹中的第一个文件。

如果有人能帮助我完成最后一点，我们将不胜感激！

由于

Answer 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

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

1 个答案: