从众多文本文件中提取多行数据，并关联到Excel中

Question

Any suggestions on how to modify the script from:

Extract a single line of data from numerous text files and import into Excel

To generate an excel sheet that has the file name in one column (the file name of the .ini file), the Latitude in a second column and the Longitude in the third column? I also have a bunch of .ini files that contain camera parameters for a .jpg, but need to extract the Name, Lat and Long for further processing.

Here is a sample of the .ini file:

---

[top_left]
lng =  -80.5251854921
lat =   46.6276919869

[top_right]
lng =  -80.5307483620
lat =   46.6297628116

[bottom_left]
lng =  -80.5229096407
lat =   46.6307857000

[bottom_right]
lng =  -80.5281836560
lat =   46.6327636148

[center]
lng =  -80.5267096969
lat =   46.6302821844

[origin]
Xs =       319.50000
Ys =       239.50000

[map]
A00 =         0.0008197901
A01 =        -0.0085907931
A02 =       -80.5267154968
A10 =        -0.0004764527
A11 =         0.0049839176
A12 =        46.6302857603
A20 =        -0.0000102856
A21 =         0.0001067452
A22 =         1.0000000000

[frameTimestamp]
frameTs = 0

---

I tried using some of the code from extract data from multiple text files in a folder into excel worksheet with little success.

Answer 1

This should do what you want - but there's no error processing - it assumes that each file is laid out as you've shown in your example. Also I'm assuming any of the lat/lng pairs are okay and that you only want one of them; hence, I extract the one associated with 'top_left'. Also all .ini files are in C:Temp\\Test directory and assumes that you want the data appended after the last row in the ActiveSheet:

Option Explicit

Sub ExtractLatLng()
    Dim MyFolder As String, MyFile As String, textline As String
    Dim r As Integer, pos As Integer

    MyFolder = "C:\Temp\Test\"
    MyFile = dir(MyFolder & "*.ini")

    r = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row + 1
    Do While MyFile <> ""
        Open (MyFolder & MyFile) For Input As #1
        Do Until EOF(1)
          Line Input #1, textline
          pos = InStr(textline, "[top_left]")
          If pos = 1 Then
             ActiveSheet.Cells(r, "A").Value = MyFile
             Line Input #1, textline
             pos = InStr(textline, "=")
             ActiveSheet.Cells(r, "C").Value = Mid(textline, pos + 1)
             Line Input #1, textline
             pos = InStr(textline, "=")
             ActiveSheet.Cells(r, "B").Value = Mid(textline, pos + 1)
             r = r + 1
             Exit Do
          End If
        Loop
        Close #1
        MyFile = dir()
    Loop 
End Sub