C
Claus Haslauer
Hi,
I have lots of txt files. I want to get only the lines between two "key
words" imported into cells in an excel workbook.
The text file looks like this:
XXBegin ->
Obs Measured Calculated Res \lambda
value value
o1-1 50.81 50.3042 0.505811 1
o1-2 51.29 52.333 -1.04303 1
o1-3 50.59 49.9261 0.663929 1
o1-4 50.53 49.5205 1.00946 1
YY Begin ->
I want everything between XXBegin -> and before YY Begin -> in a workbook.
My current code is a mixture between
http://groups.google.com/group/micr...q=parsing+file+excel&rnum=16#cfa8fcda00624a44
and a code from JWalk's book (see below). This current scripts simply
copies the entire file into a worksheet starting at the active cell.
There are two things that I'd like to change:
1) copy the code only between the indicated "key words". How is that
best doable? I've heard about regular expressions, but I'm not sure if
excel can use them, and if yes, how it would be possible to incorporate
them into VBA
2) somehow change the delimiter from " " to some better solution (like
columns, similar to the breakline in the text import wizard
Thanks for your help,
Claus
Here is the code:
Sub FilterFile()
Dim i1 As Integer
Dim i2 As Integer
Dim Counter As Long
Dim strPath As String
Dim stRead As String
Dim a As Integer
'new additions:
Dim strSource As String
Dim vFile As Variant
'CPH additions
Dim TextToFind As String
Dim ImpRng As Range
Dim r As Long, c As Integer
Dim txt As String
Dim Data
'Start with Active Cell
Set ImpRng = ActiveCell
'Dialogue to choose the file that I want to parse
vFile = Application.GetOpenFilename("Text" & " Files (T:\.*), *.*")
If vFile = False Then Exit Sub 'cancelled
strSource = CStr(vFile)
strPath = CurDir & "\Batch" 'adding "1.txt" later on
i1 = FreeFile
Open strSource For Input As #i1 'SOURCE
r = 0
c = 0
txt = ""
Application.ScreenUpdating = False
'TextToFind = " XX Begin ->"
Do Until EOF(i1)
Line Input #i1, Data
For i = 1 To Len(Data)
Char = Mid(Data, i, 1)
If Char = " " Then
ActiveCell.Offset(r, c) = txt
c = c + 1
txt = ""
ElseIf i = Len(Data) Then
If Char <> Chr(34) Then txt = txt & Char
ActiveCell.Offset(r, c) = txt
txt = ""
ElseIf Char <> Chr(34) Then
txt = txt & Char
End If
Next i
c = 0
r = r + 1
Loop
Close #i1
Application.ScreenUpdating = True
End Sub
I have lots of txt files. I want to get only the lines between two "key
words" imported into cells in an excel workbook.
The text file looks like this:
XXBegin ->
Obs Measured Calculated Res \lambda
value value
o1-1 50.81 50.3042 0.505811 1
o1-2 51.29 52.333 -1.04303 1
o1-3 50.59 49.9261 0.663929 1
o1-4 50.53 49.5205 1.00946 1
YY Begin ->
I want everything between XXBegin -> and before YY Begin -> in a workbook.
My current code is a mixture between
http://groups.google.com/group/micr...q=parsing+file+excel&rnum=16#cfa8fcda00624a44
and a code from JWalk's book (see below). This current scripts simply
copies the entire file into a worksheet starting at the active cell.
There are two things that I'd like to change:
1) copy the code only between the indicated "key words". How is that
best doable? I've heard about regular expressions, but I'm not sure if
excel can use them, and if yes, how it would be possible to incorporate
them into VBA
2) somehow change the delimiter from " " to some better solution (like
columns, similar to the breakline in the text import wizard
Thanks for your help,
Claus
Here is the code:
Sub FilterFile()
Dim i1 As Integer
Dim i2 As Integer
Dim Counter As Long
Dim strPath As String
Dim stRead As String
Dim a As Integer
'new additions:
Dim strSource As String
Dim vFile As Variant
'CPH additions
Dim TextToFind As String
Dim ImpRng As Range
Dim r As Long, c As Integer
Dim txt As String
Dim Data
'Start with Active Cell
Set ImpRng = ActiveCell
'Dialogue to choose the file that I want to parse
vFile = Application.GetOpenFilename("Text" & " Files (T:\.*), *.*")
If vFile = False Then Exit Sub 'cancelled
strSource = CStr(vFile)
strPath = CurDir & "\Batch" 'adding "1.txt" later on
i1 = FreeFile
Open strSource For Input As #i1 'SOURCE
r = 0
c = 0
txt = ""
Application.ScreenUpdating = False
'TextToFind = " XX Begin ->"
Do Until EOF(i1)
Line Input #i1, Data
For i = 1 To Len(Data)
Char = Mid(Data, i, 1)
If Char = " " Then
ActiveCell.Offset(r, c) = txt
c = c + 1
txt = ""
ElseIf i = Len(Data) Then
If Char <> Chr(34) Then txt = txt & Char
ActiveCell.Offset(r, c) = txt
txt = ""
ElseIf Char <> Chr(34) Then
txt = txt & Char
End If
Next i
c = 0
r = r + 1
Loop
Close #i1
Application.ScreenUpdating = True
End Sub