Process to Import specific text in excel with VBA-CodePudding

I'm trying to import many tables into excel (with fixed width option selected) and I would like it to paste it to certain areas as a function of "i", see below: For i = 0 to X

I would like "X" to be the number of tables that are imported from the text file, I think the Count function can be used here but I'm not sure how

So far I have this code written up, but I'm not sure what the syntax is for the commends I posted after some of the commands:

Sub ImportLPileTextFile()
    Dim myFile As String, text As String, textline As String, pos1 As Integer, pos2 As Integer

    myFile = Application.GetOpenFilename()
        
    Open myFile For Input As #1
        
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop
    Close #1
        
    pos1 = InStr(text, "   y, inches ")
    pos2 = InStr(text, "000         ") 'I'm using the zero values after the decimal becuase the end text is sometimes different
                                       'can I set this second condition to be "if two blank lines appear" somehow?
                                       'There are a minimum of 2 open spaces after the table ends. See photo

     For i = 0 To 'Count(how many items are pasted)
     
         Range(.Cells(8, 3 * i   1)).Value = Mid(text, pos1   0, 0) ' is 0 right? I want to include this in what I want copied, see photo example
         'How do i paste this table as a special paste with "Fixed width" option?
                
     Next i
End Sub

I know the i = 0 to ... loop is not in the right area, it needs to be before Loop for Do Until ? Right?

Below are two images:

Of what the file would look like after it's pasted into my ActiveSheet. I've placed notes in the image to show the purpose of my i = 0 to ... function. Note the "paste data below..." is where I'd like the data pasted.
The actual text file and the exact data I need to pull from:

Word version of the text file with the paragraph option showing all indentations per the request of Tim. Left shows how the first table will always look, the second is how the second and remaining tables will look. Worst case scenario, they'll all always have "y,inches p,lbs.in" above them, so I can always use that as the first string to look for, I don't necessarily have to have those in my excel, I can manually input them and have the actual numbers be the data that's copied.

When I copy from the text file and paste special into excel with "Fixed Width" option, then it pastes perfectly with the two columns as shown in my excel image above.

Thanks in advance for taking the time to look at this and giving me advice and direction.

CodePudding user response：

This worked for me - you may need to tweak it a bit to get everything to go where you want.

Sub ImportLPileTextFile()
    Dim colTables As Collection, tbl As Collection, cDest As Range
    Dim ws As Worksheet, rw, n As Long, fName As String
    
    Set ws = ActiveSheet        'or whatever
    Set cDest = ws.Range("A8")  'tables start here
    
    fName = Application.GetOpenFilename()
    If Len(fName) = 0 Then Exit Sub
    
    Set colTables = GetFileData(fName) 'read the file
    Debug.Print "Found " & colTables.Count & " tables"
    
    For Each tbl In colTables
        n = 0
        'write the header
        cDest.Resize(1, 2).Value = Array("y, inches", "p, lbs/in")
        For Each rw In tbl                           'loop all rows
            n = n   1                                'next output line down
            cDest.Offset(n).Resize(1, 2).Value = rw  'write a row
        Next rw
        Set cDest = cDest.Offset(0, 3) 'next table output start cell
    Next tbl
End Sub

'Given a file path, return a collection of collections, where each contained
'  collection rpresents one table, and is a set of arrays of (yvalue, p value)
'  representing "rows" in that table
Function GetFileData(fPath As String)
    Dim colTables As New Collection, fso As Object, f As Object, txt
    Dim inTable As Boolean, tbl As Collection, iBlank As Long, y, p
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set f = fso.opentextfile(fPath, 1) 'for reading
    Do Until f.AtEndOfStream
        txt = f.readline()
        iBlank = IIf(Len(txt) = 0, iBlank   1, 0) 'counting consecutive blank lines
        
        'start of a table?
        If txt Like "*y, inches*p, lbs/in*" Then
            Set tbl = New Collection  'start a new collection for rows
            inTable = True            'set flag
        Else
            If inTable Then
                If Len(txt) > 20 Then  'have some data?
                    'skip the "------" header
                    If Not txt Like "*----*" Then
                        y = Trim(Left(txt, 14))
                        p = Trim(Mid(txt, 15))
                        'if y and p are numeric then add as a "line"
                        If IsNumeric(y) And IsNumeric(p) Then
                            tbl.Add Array(CDbl(y), CDbl(p))
                        End If
                    End If
                Else
                    If iBlank >= 2 Then
                        'done with this table
                        inTable = False    'reset flag
                        colTables.Add tbl  'add table to return collection
                    End If 'two consecutive blank lines
                End If
            End If
        End If
    Loop
    Set GetFileData = colTables
End Function