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

问题描述

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

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.

我已经看过各种其他类似的线程，例如：（对不起，不是stackoverflow！）

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

...

我写了以下代码：

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坐标。

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!

谢谢

推荐答案

您必须重置您的文本否则第二个文件的内容将被添加，而不是替换，搜索总是找到第一个GPS数据并停止搜索：

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

这篇关于从多个文本文件中提取单行数据并导入Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！