Parsing Text file into excel using VBA - excel

Question

I am new to VBA and I could use a little bit of help for a program which I am struggling with for the past 3 days.
I have lot of data in a text file arranged as 3 columns. This data has to be parsed in an excel
The column 1 corresponds to the time, column 2 the variable and column 3 the value corresponding the variable .
The excel should parse the data such a way that column 1 has time, and column 2,3,4,5,6,7 the values corresponding to the variables in column 2 of the text file. and the values are in hex datei which has to be converted to decimal.
here is the code
Sub OpenText()
Dim MyFile As Variant
Dim TempWb As Workbook
Dim DestSh As Worksheet
Dim i As Long, p As Long, LimitRow As Long
Dim LastRow As Long
Dim LastRow2 As Long
p = 2
' Ask the user for the file name to open.
MyFile = Application.GetOpenFilename()
' Check for the Cancel button.
If MyFile = False Then Exit Sub
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.ActiveSheet
'Open the Text file with the OpenText method.
Workbooks.OpenText Filename:=MyFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar _
:=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1)), _
DecimalSeparator:=".", ThousandsSeparator:=" ", TrailingMinusNumbers:= _
True
Set TempWb = ActiveWorkbook
LimitRow = 1048576 'Version Excel 2010
LastRow = Range("A" & LimitRow).End(xlUp).Row
If LastRow > 0 Then
For i = 1 To LastRow
If i = 1 Then
Cells(p, 1).Value = Cells(i, 1).Value
End If
Test = Cells(i, 2).Value
If Test = "0x005B" Then Cells(p, 2).Value = Cells(i, 3).Value Else _
If Test = "0x003E" Then Cells(p, 3).Value = Cells(i, 4).Value Else _
If Test = "0x0033" Then Cells(p, 4).Value = Cells(i, 3).Value Else _
If Test = "0x0039" Then Cells(p, 5).Value = Cells(i, 3).Value Else _
If Test = "0x003B" Then Cells(p, 6).Value = Cells(i, 3).Value Else _
If Test = "0x003D" Then Cells(p, 7).Value = Cells(i, 3).Value Else _
Next
End If
End Sub
The text file looks somewhat like this
2017-03-23_11-48-32.8;0x003E;0x1000
2017-03-23_11-48-32.8;0x0033;0x01F4
2017-03-23_11-48-32.8;0x0039;0x6720
2017-03-23_11-48-32.8;0x003B;0x6720
2017-03-23_11-48-32.8;0x003D;0x0050
2017-03-23_11-48-32.8;0x005E;0x1234ABCD
2017-03-23_11-48-33.1;0x0033;0x01F4
2017-03-23_11-48-33.1;0x0039;0x6720
2017-03-23_11-48-33.1;0x003B;0x6720
2017-03-23_11-48-33.4;0x003E;0x1000
2017-03-23_11-48-33.4;0x0033;0x01F4
2017-03-23_11-48-33.4;0x0039;0x6720
2017-03-23_11-48-33.4;0x003B;0x6720
2017-03-23_11-48-33.4;0x003D;0x0050
2017-03-23_11-48-33.4;0x005E;0x1234ABCD
2017-03-23_11-48-33.7;0x0033;0x01F4
2017-03-23_11-48-33.7;0x0039;0x6720
2017-03-23_11-48-34.0;0x003E;0x1000
2017-03-23_11-48-34.0;0x0033;0x01F4
2017-03-23_11-48-34.0;0x0039;0x6720
2017-03-23_11-48-34.0;0x003B;0x6720
2017-03-23_11-48-34.0;0x003D;0x0050
2017-03-23_11-48-34.0;0x005E;0x1234ABCD
2017-03-23_11-48-34.3;0x0033;0x01F4
2017-03-23_11-48-34.3;0x0039;0x6720
2017-03-23_11-48-34.3;0x003B;0x6720
2017-03-23_11-48-34.6;0x003E;0x1000
2017-03-23_11-48-34.6;0x0033;0x01F4
2017-03-23_11-48-34.6;0x0039;0x6720
2017-03-23_11-48-34.6;0x003B;0x6720
2017-03-23_11-48-34.6;0x003D;0x0050
2017-03-23_11-48-34.6;0x005E;0x1234ABCD
2017-03-23_11-48-34.9;0x0033;0x01F4
2017-03-23_11-48-34.9;0x0039;0x6720
2017-03-23_11-48-34.9;0x003B;0x6720
2017-03-23_11-48-35.2;0x003E;0x1000
2017-03-23_11-48-35.2;0x0033;0x01F4
2017-03-23_11-48-35.2;0x0039;0x6720
2017-03-23_11-48-35.2;0x003B;0x6720
2017-03-23_11-48-35.2;0x003D;0x0050
2017-03-23_11-48-35.2;0x005E;0x1234ABCD
2017-03-23_11-48-35.5;0x0033;0x01F4
2017-03-23_11-48-35.5;0x0039;0x6720
2017-03-23_11-48-35.5;0x003B;0x6720
And also the excel gets created in a different worksheet instead of the current worksheet.
Thanks in advance

Answer 1

Hope this resolve ur problem
Public Sub Append_text()
Set fso = New FileSystemObject
FLoc = "Y:\Macro\Test" & Format(Now(), "HHMMSS") & ".txt"
Set Stream = fso.OpenTextFile(FLoc, ForAppending, True)
x = 1 'Hoping the start point
Do Until Sheet1.Cells(x, 1) = "" 'U can use the end of file code here for looping till last row
Stream.Write Sheet1.Cells(x, 1) & ";" & Sheet1.Cells(x, 2) & ";" & Sheet1.Cells(x, 3) & vbNewLine
x = x + 1
Loop
End Sub
Public Sub Read_text()
Sheet2.Activate
Set fso = New FileSystemObject
Fname = Application.GetOpenFilename
x = 1
y = 1
Set Stream = fso.OpenTextFile(Fname, ForReading, True)
Do While Not Stream.AtEndOfStream
Str_text = Stream.ReadLine 'Perform your actions
rdtext = Split(Str_text, ";")
Sheet2.Cells(x, y) = rdtext(0)
Sheet2.Cells(x, y + 1) = rdtext(1)
Sheet2.Cells(x, y + 2) = rdtext(2)
x = x + 1
y = 1
Loop
Stream.Close
End Sub

Answer 2

Not directly on point to the problem but does answer Parsing Text file using VBA.
This is an auto-detect routine. You can add it to a customized tab by temporarily substituting a Sub line with no parameter and adding that. Then replace the Sub line with the real line with the optional parameters.
If you don't specify any of the Optional delimiters, this looks at the first 5 lines of the file and checks for common delimiters. For example, if any of those lines contains more than 8 pipes it assumes pipe is the delimiter.
BEWARE OF THE 'AUTOMATIC COMMA-SPLIT' ISSUE IN THE COMMENT. That is an EXCEL quirk, not a problem with .TextToColumns. Excel "remembers" choices previously made in the Data tab when someone used Get External Data or Data Tools > Text to Columns and might automatically re-perform that parsing when the file is opened.
Option Explicit
Sub Parse_any_delimited( _
Optional ByVal dlm_pipe As Boolean = False, _
Optional ByVal dlm_semi As Boolean = False, _
Optional ByVal dlm_comma As Boolean = False, _
Optional ByVal dlm_tab As Boolean = False, _
Optional ByVal dlm_carat As Boolean = False, _
Optional ByVal dlm_char As String = "", _
Optional ByVal no_delim_popup As Boolean = True)
' *** WARNING !!! ***
'
' The FIRST record that EXCEL will see DURING AN IMPORT CANNOT CONTAIN
' COMMAS! IF IT DOES, it interprets those as DELIMITERS and AUTOMATICALLY
' does a field split there BEFORE running any code! The result is that
' when all text SHOULD wind up in Cell A1, instead it gets parsed into
' cells at each comma. Then the REAL PARSE routine can only parse what
' IS in the Column A cells.
'
' The "comma parse" UPON LOADING occurs BEFORE any macro runs!
Dim i As Integer
Dim check_data As Boolean
check_data = False
Dim dlm_other As Boolean
dlm_other = False
Dim rcrd As Variant
Dim leave_for As Boolean
Dim have_delim As Boolean
'1 ****
If dlm_pipe Then
dlm_other = True
dlm_char = "|"
have_delim = True
'2 ****
ElseIf dlm_carat Then
dlm_other = True
dlm_char = "^"
have_delim = True
'3 ****
ElseIf dlm_tab Or dlm_semi Or dlm_comma Then
have_delim = True
'4 ****
Else
For i = 1 To 5 'Check first 5 records for common delimiters
leave_for = True
rcrd = Cells(i, "A").Value
If Count_Characters(rcrd, "|") > 5 Then
dlm_other = True
dlm_char = "|"
ElseIf Count_Characters(rcrd, ";") > 5 Then
dlm_semi = True
ElseIf Count_Characters(rcrd, ",") > 10 Then
dlm_comma = True
ElseIf Count_Characters(rcrd, vbTab) > 4 Then
dlm_tab = True
ElseIf Count_Characters(rcrd, "^") > 5 Then
dlm_other = True
dlm_char = "^"
Else
leave_for = False
End If
'===============
If leave_for Then
have_delim = True
Exit For
Else
have_delim = False
End If
Next i
'5 ****
End If
If have_delim = False Then
' B2 is checked because in certain cases Excel will
' AUTOMATICALLY parse data delimited by | or semicolons.
' When that happens, THIS sub sees it as "No delimiter Can't Parse"
' even though it HAS BEEN parsed.
If Cells(2, "B").Value = "" And no_delim_popup Then
MsgBox ("CAN'T PARSE - NO DELIMITER FOUND")
End If
Exit Sub
End If
' Stops "There's already data here--continue?"
Application.DisplayAlerts = False
Columns("A:A").Select
Selection.TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=dlm_tab, _
Semicolon:=dlm_semi, _
Comma:=dlm_comma, _
Space:=False, _
Other:=dlm_other, _
OtherChar:=dlm_char
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
Application.DisplayAlerts = True
' Sub Parse_any_delimited()
End Sub
Function Count_Characters( _
ByVal str As Variant, _
ByVal chr As Variant) _
As Long
Count_Characters = Len(str) - Len(Replace(str, chr, ""))
End Function