從眾多文本文件中提取單行數據並導入Excel

Question

我在一個文件夾中有數百個文本文件，我需要從每個文件夾中提取一行並將信息放入excel中。 文本文件包含單個照片的所有元數據，我只需要取出GPS坐標。

我查看了各種其他類似的線程，例如： 將文件夾中多個文本文件的數據提取到excel工作表中

和：

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