修改VBA代码实现从多TXT文件提取不定长GPS坐标导入Excel

Sub ExtractGPS()
    Dim nextrow As Long, MyFolder As String
    Dim MyFile As String, textline 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
            ' 逐行检测是否包含GPS Position标识
            If InStr(textline, "GPS Position") > 0 Then
                ' 找到后提取冒号后的全部内容，Trim去掉前后多余空格
                nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row + 1
                Sheet1.Cells(nextrow, "A").Value = Trim(Mid(textline, InStr(textline, ":") + 1))
                ' 找到目标行后可直接退出当前文件的读取，节省性能
                Exit Do
            End If
        Loop
        Close #1
        MyFile = Dir()
    Loop
End Sub

• 去掉了原代码把所有行拼接成一个长文本的逻辑，改为逐行读取直接检测目标标识，避免丢失换行符导致无法定位行尾
• 替换原固定长度截取的逻辑：先找到该行冒号的位置，直接提取冒号之后到行尾的所有内容，用Trim函数去掉前后多余的空格即可适配任意长度的GPS坐标内容
• 新增匹配到目标行后直接退出当前文件读取的逻辑，减少不必要的性能消耗
• 不需要依赖固定的偏移量计算，即使后续GPS Position和冒号之间的空格数量变化也能正常匹配

内容的提问来源于stack exchange，提问作者mike bannister