script to import parts of txt file

[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

 

[mike.thompson]

If those are the exact values that are loaded, is it possible to just
delete the row after populating the worksheet and before moving to the
next file?

This may work.

Sub CleanWS()
'Clear the First Indicator
Range("A1").End(xlDown).Select
With Selection
If Selection.Value = "XXBegin" Then
Selection.EntireRow.Delete
End If
End With

'Clear the Second Indicator
Range("A65536").End(xlUp).Select
With Selection
If Selection.Value = "YY Begin" Then
Selection.EntireRow.Delete
End If
End With
End Sub