Excel VBA text file parsing help

[mseawell]

Hello,

I'm attempting to create a tool to parse a text file for particular data points and import them into an Excel spreadsheet. Ideally, I would like to use a Command Button to select the text and import the data I want into a new WorkBook sheet.

Here's the code I have so far:


Dim myFile As String, text As String, textline As String, LineLocation As String, DN As Integer, CardCode As String, GND As String
Sub Button1_Click()
'Add a new sheet
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Working LENs"
'Add column headers
Range("A1").Value = "Line Location"
Range("B1").Value = "DN "
Range("C1").Value = "CardCode"
Range("D1").Value = "GND"
'Show open file dialog box
myFile = Application.GetOpenFilename()
'Open file
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
'Close file
Close #1
LineLocation = InStr(text, "LEN:")
DN = InStr(text, "DN")
CardCode = InStr(text, "CARDCODE:")
GND = InStr(text, "GND:")
Range("=$A$2").Value = Mid(text, LineLocation + 5, 20)
Range("=$B$2").Value = Mid(text, DN + 3, 10)
Range("=$C$2").Value = Mid(text, CardCode + 9, 8)
Range("=$D$2").Value = Mid(text, GND + 4, 2)
End Sub

Private Sub CommandButton1_Click()

End Sub

With this code I'm able to create the headers for each row and import the first row of data. But it is not importing the data from the remainder of my text file.
Also, it is creating the new sheet but the data is imported into the sheet where the command button is located.

I have attached an example of my text file I'm wanting to parse and the output I'm wanting to acheive.

Thanks,

Mark

[mseawell]

Attaching the example files

17506

17505

[mana]

Option Explicit


Sub test()
Dim myPath As String
Dim c As Range
Dim s As String
Dim v() As String
Dim n As Long

myPath = "C:\***\***\InputFile.csv"

With Workbooks.Open(myPath).Sheets(1)
For Each c In .Range("a1", .Range("a1").End(xlDown))
s = c.Value
If s Like "LEN:*" Then
n = n + 1
ReDim Preserve v(1 To 4, 1 To n)
v(1, n) = Trim(Mid(s, 5))
End If
If s Like "DN *" Then
v(2, n) = Split(Trim(Mid(s, 3)))(0)
End If
If s Like "CARDCODE:*" Then
v(3, n) = Split(Trim(Mid(s, 10)))(0)
v(4, n) = Split(Trim(Mid(s, InStr(s, "GND:") + 4)))(0)
End If
Next
.Parent.Close False
End With

ThisWorkbook.Worksheets.Add
Range("a1").Resize(, 4).Value = Array("len", "DN", "CardCode", "GND")
Range("a2").Resize(n, 4).Value = WorksheetFunction.Transpose(v)

End Sub

[p45cal]

…or without opening the input file in Excel, while adjusting your code minimally:
Sub blah()
Dim myFile As String, LineLocation As Long, DN As Long, CardCode As Long, GND As Long, Destn As Range, alltext As String, Z, y
'Add a new sheet
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = "Working LENs"
'Add column headers
.Range("A1:D1").Value = Array("Line Location", "DN ", "CardCode", "GND")
Set Destn = .Range("A2")
myFile = Application.GetOpenFilename()
'Open and read file:
alltext = CreateObject("Scripting.FileSystemObject").OpenTextFile(myFile, 1).readall
Close
Z = Split(alltext, "-" & vbCrLf)
For Each y In Z
If InStr(y, "LEN:") > 0 Then
LineLocation = InStr(y, "LEN:")
DN = InStr(y, "DN")
CardCode = InStr(y, "CARDCODE:")
GND = InStr(y, "GND:")

If LineLocation > 0 Then Destn.Value = Mid(y, LineLocation + 5, 20)
Destn.Offset(, 1).NumberFormat = "@"
If DN > 0 Then Destn.Offset(, 1).Value = Mid(y, DN + 3, 10)
If CardCode > 0 Then Destn.Offset(, 2).Value = Mid(y, CardCode + 9, 8)
If GND > 0 Then Destn.Offset(, 3).Value = Mid(y, GND + 4, 2)
Set Destn = Destn.Offset(1)
End If
Next y
.Columns("A:D").EntireColumn.AutoFit
End With
End Sub

See attachment.

[mseawell]

Sorry, I've been busy on other projects.

Thanks for your input!

Mark

[mseawell]

I tried this out on a larger file and it works like a charm.

Many thanks!