从大量文本文件中提取一行数据并导入Excel

我在一个文件夹中有数百个文本文件，我需要从每个文件中提取一行，并将信息放入excel。文本文件包含了个人照片的所有元数据，我只需要取出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:\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

Sub-ExtractGPS（）
Dim文件名为字符串，nextrow为长，MyFolder为字符串
Dim MyFile作为字符串、text作为字符串、textline作为字符串、posGPS作为字符串
MyFolder=“C:\Users\Desktop\Test\”
MyFile=Dir（MyFolder&“*.txt”）
当我的文件“”时执行此操作
打开（MyFolder&MyFile）作为#1输入
直到EOF（1）为止
行输入#1，文本行
text=文本和文本行
环
关闭#1
MyFile=Dir（）
posGPS=仪表（文本，“GPS位置”）
nextrow=Sheet1.单元格（Rows.Count，“A”）.结束（xlUp）.行+1
表1.单元格（nextrow，“A”）。值=中间（文本，posGPS+33,37）
环
端接头

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

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

---

谢谢

您必须重置您的

文本

，否则第二个文件的内容将被添加而不会被替换，搜索将始终找到第一个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

Sub-ExtractGPS（）
Dim文件名为字符串，nextrow为长，MyFolder为字符串
Dim MyFile作为字符串、text作为字符串、textline作为字符串、posGPS作为字符串
MyFolder=“C:\Temp\Test\”
MyFile=Dir（MyFolder&“*.txt”）
当我的文件“”时执行此操作
打开（MyFolder&MyFile）作为#1输入
直到EOF（1）为止
行输入#1，文本行
text=text&textline'第二个循环文本已存储->请参阅重置文本
环
关闭#1
MyFile=Dir（）
调试。打印文本
posGPS=仪表（文本，“GPS位置”）
nextrow=ActiveSheet.Cells（Rows.Count，“A”）.End（xlUp）。Row+1
ActiveSheet.Cells（nextrow，“A”）.Value=Mid（text，posGPS+33,37）
text=“”重置文本
环
端接头

太棒了，完成了。我以为会是这么简单！非常感谢。问题布置得很好——保持良好的开端。

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