I need to extract data from text file into Excel file. I once asked at Vbscript extract data from Text File into Excel
But after trying for few weeks and still no success so I use vba instead. Here what i have:
Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
Dim idx%
MyFolder = "D:\Automation\VSWR\"
MyFile = Dir(MyFolder & "VSWR W51.txt")
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(1, 1).Value = "eNodeBName"
Cells(1, 2).Value = "Time"
Cells(1, 3).Value = "MML SN"
Cells(1, 4).Value = "MML Command"
Cells(1, 5).Value = "Retcode"
Cells(1, 6).Value = "Explain_info"
Cells(1, 7).Value = "Cabinet No."
Cells(1, 8).Value = "Subrack No."
Cells(1, 9).Value = "Slot No."
Cells(1, 10).Value = "TX Channel No."
Cells(1, 11).Value = "VSWR(0.01)"
'Columns(1).EntireColumn.AutoFit
Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #1, textline 'read a line
idx = InStr(textline, "NE")
If idx > 0 Then
'ActiveSheet.Cells(nextrow, "A").Value = Mid(textline, idx + 5)
ActiveSheet.Cells(nextrow, "A").Value = Mid(textline, filenum + 5)
End If
idx = InStr(textline, "Report")
If idx > 0 Then
ActiveSheet.Cells(nextrow, "B").Value = Right(textline, filenum + 19)
End If
idx = InStr(textline, "O&M")
If idx > 0 Then
ActiveSheet.Cells(nextrow, "C").Value = ("O&M" & Mid(textline, filenum + 4))
End If
idx = InStr(textline, "MML Session")
If idx > 0 Then
ActiveSheet.Cells(nextrow, "D").Value = "DSP VSWR:;"
End If
idx = InStr(textline, "RETCODE")
If idx > 0 Then
ActiveSheet.Cells(nextrow, "E").Value = "0"
End If
idx = InStr(textline, "RETCODE")
If idx > 0 Then
ActiveSheet.Cells(nextrow, "F").Value = Mid(textline, filenum + 12)
'nextrow = nextrow + 1 'now move to next row
End If
idx = InStr(textline, "Cabinet No.")
If idx > 0 Then
Line Input #1, textline
Line Input #1, textline
ActiveSheet.Cells(nextrow, "G").Value = Mid(textline, filenum + 1)
nextrow = nextrow + 1 'now move to next row
End If
Loop
Close #1
MyFile = Dir()
Loop
End Sub
Almost successful but the only problem is i can't seem to figure out how to make this line split the data into 5 separate columns.
idx = InStr(textline, "Cabinet No.")
If idx > 0 Then
Line Input #1, textline
Line Input #1, textline
ActiveSheet.Cells(nextrow, "G").Value = Mid(textline, filenum + 1)
nextrow = nextrow + 1 'now move to next row
End If`
Sample input in text file Input
And my desired output should be like this Output
Thanks in advance and really appreciate.
Using Application.Trim and Split to separate the columns.
Option Explicit
Sub ExtractData()
Dim wb As Workbook, ws As Worksheet
Dim MyFile As String, MyFolder As String
Dim textline As String, ar As Variant
Dim i As Long, n As Long, count As Long
Dim arOut(10) As String, t0 As Single
t0 = Timer
MyFolder = "D:\Automation\VSWR\"
MyFile = Dir(MyFolder & "VSWR W51.txt")
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
ws.Cells.Clear
i = ws.Cells(Rows.count, "A").End(xlUp).Row + 1
ws.Range("A1:K1") = Array("eNodeBName", "Time", "MML SN", "MML Command", "Retcode", _
"Explain_info", "Cabinet No.", "Subrack No.", "Slot No.", _
"TX Channel No.", "VSWR(0.01)")
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
If count Mod 10000 = 0 Then Application.StatusBar = count
Line Input #1, textline: count = count + 1
If InStr(textline, "--- END") > 0 Then
Erase arOut ' clear array
ElseIf InStr(textline, "NE") > 0 Then
arOut(0) = Mid(textline, 5)
ElseIf InStr(textline, "Report") > 0 Then
arOut(1) = Right(textline, 19)
ElseIf InStr(textline, "O&M") > 0 Then
arOut(2) = "O&M" & Mid(textline, 4)
ElseIf InStr(textline, "MML Session") > 0 Then
arOut(3) = "DSP VSWR:;"
ElseIf InStr(textline, "RETCODE") > 0 Then
arOut(4) = Mid(textline, 11, 1)
arOut(5) = Mid(textline, 12)
ElseIf InStr(textline, "Cabinet No.") > 0 Then
Line Input #1, textline: count = count + 1
Line Input #1, textline: count = count + 1
Do While Left(textline, 7) <> "(Number"
textline = Application.Trim(textline)
ar = Split(textline, " ")
'Debug.Print count, textline, UBound(ar)
For n = 0 To 4
arOut(6 + n) = ar(n)
Next
ws.Range("A" & i & ":K" & i).Value = arOut
i = i + 1 ' now move to next row
Line Input #1, textline: count = count + 1
Loop
End If
Loop
Close #1
MsgBox Format(count, "#,##0") & " rows read", vbInformation, Int(Timer - t0) & " seconds"
End Sub
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments