VB script/macro for excel to extract numbers from txt file

Sub GetData()

Dim FF As Integer
Dim strLine As String
Dim intPos As Integer
Dim lngRow As Long
Dim dlgFile As FileDialog
Dim FileChosen As Integer
Dim bType2 As Boolean

FF = FreeFile

' Choose the file to open
Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)
'the number of the button chosen
FileChosen = dlgFile.Show
dlgFile.Title = "Please choose file to import"
' Set the initial folder selection
dlgFile.InitialFileName = ThisWorkbook.Path
dlgFile.InitialView = msoFileDialogViewList
dlgFile.Filters.Clear
dlgFile.Filters.Add "Text Files", "*.txt"
dlgFile.Filters.Add "All files", "*.*"
dlgFile.FilterIndex = 1
' Set the ButtonName property to control the text on
' the OK button (the ampersand means the following
' letter is underlined and choosable with the ALT key)
dlgFile.ButtonName = "&Select file"
If FileChosen <> -1 Then
    MsgBox "You chose cancel"
    Exit Sub
End If

Open dlgFile.SelectedItems(1) For Input As #FF
 
' There are two types of files. One which I'll call Type 1 has no header lines and
' 4 data lines in each set of data, while the other which I'll call type 2 has 3
' header lines and 3 data lines in each set of data.

' Type 1 layout
' repeating set consiting of
'   blank line
'   4 lines of data

' Type 2 layout
' blank line
' "Steak-Out"
' header data
' repeating set consiting of
'   blank line
'   3 lines of data


' By pass the first line which is always blank.
Line Input #FF, strLine

' Determine if we have a Type1 file
Line Input #FF, strLine
' I could look for "Stake-out" which is what is in the one
' sample file that I have, but I'm assuming that that could change
' so instead since all data lines are longer than 20, I'm using
' that fact
If Len(strLine) < 20 Then
    bType2 = True
    ' Bypass the next header lines
    Line Input #FF, strLine
    Line Input #FF, strLine
Else
    bType2 = False
End If

Do While Not EOF(FF)
    If strLine = "" Then
        Line Input #FF, strLine
    ElseIf Left$(strLine, 3) = "Pt:" Then
        Line Input #FF, strLine
        ' Ignore the two footer lines at the end of type 2 files
        If Left$(strLine, 6) = "Pt.No." Then
            Close
            Exit Sub
        End If
        Line Input #FF, strLine
    End If
    
    
    ' Find the first dash
    intPos = InStr(1, strLine, "-")
    lngRow = lngRow + 1
    Sheets("Sheet1").Cells(lngRow, 1) = Mid$(strLine, intPos + 10, 5)
    
    ' Get to the last line in the set
   
    Line Input #FF, strLine
    Line Input #FF, strLine
    ' Type 1 files have 3 data lines while other have 4
    If Not bType2 Then
        Line Input #FF, strLine
    End If
        
    ' Find "N:"
    intPos = InStr(1, strLine, "N:")
    Sheets("Sheet1").Cells(lngRow, 2) = Mid$(strLine, intPos + 2, 10)
    ' Find "E:"
    intPos = InStr(intPos, strLine, "E:")
    Sheets("Sheet1").Cells(lngRow, 3) = Mid$(strLine, intPos + 2, 10)
    ' Find "El:"
    intPos = InStr(intPos, strLine, "El:")
    Sheets("Sheet1").Cells(lngRow, 4) = Mid$(strLine, intPos + 3, 6)
Loop

Close
End Sub

Select allOpen in new window