Solved: How to import text file & extract specified strings

Hi all,

I have a log file with below information..

e.g (FindA.txt)
Product:ACT16.exe
Date issued:2006-7-3 11:43:12
Issued to:Hubei
Type=Non-networked (fixed)
Copies=1
Level=0
Restriction=120 Days
Options=
6: PrintPlan
8: CORR
12: Stats
14: TELGRAPH
15: Scatmain (Bmaps)
16: Corresp

I need to look at this text file and fill in the excel record. Here's my problem... (e.g Sample.xls), I need to put different answers in different columns, how can I make use of VBA code instead of editing the file manually?

Many Thanks! :)

In the text file the options go up to number 16 but in the worksheet you've only included the options that appear in the text file.

Are there other options?

Hi snoopies (and Hi Norie),

Give the following a try, I have the text file hard coded now but that can easily be changed to be chosen at runtime. This uses regular expressions to parse the text file, based on pattern matching. If you have more options you want to add (as Norie is asking about), you can just add more lines for the different options, depending on where you want it placed:[vba]Sub snoopies()
Dim vFile As String, vFF As Long, tempStr As String
Dim RegEx As Object, RegC As Object, RegM As Object
vFile = "C:\FileA\FileA.txt"
vFF = FreeFile
Open vFile For Binary As #vFF
tempStr = Space$(LOF(vFF))
Get #vFF, , tempStr
Close #vFF
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "Product[^\x00]+?-----"
End With
If RegEx.Test(tempStr) Then
Set RegC = RegEx.Execute(tempStr)
For Each RegM In RegC

With Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
.Cells(1) = RegExCheck(RegM, RegEx, _
"Date issued:([\d-]+)")
.Cells(2) = RegExCheck(RegM, RegEx, _
"Date issued:[\d-]+ ([\d:]+)")
.Cells(3) = RegExCheck(RegM, RegEx, _
"Issued to:([^\n\r]+)")
.Cells(4) = RegExCheck(RegM, RegEx, _
"Type=([^\n\r]+)")
.Cells(5) = RegExCheck(RegM, RegEx, _
"Copies=([^\n\r]+)")
.Cells(6) = RegExCheck(RegM, RegEx, _
"Level=([^\n\r]+)")
.Cells(7) = RegExCheck(RegM, RegEx, _
"Restriction=(\d+)")
.Cells(8) = IIf(Len(RegExCheck(RegM, RegEx, _
"[\n\r](6:)")) > 0, "Yes", "")
.Cells(9) = IIf(Len(RegExCheck(RegM, RegEx, _
"[\n\r](8:)")) > 0, "Yes", "")
.Cells(10) = IIf(Len(RegExCheck(RegM, RegEx, _
"[\n\r](12:)")) > 0, "Yes", "")
.Cells(11) = IIf(Len(RegExCheck(RegM, RegEx, _
"[\n\r](14:)")) > 0, "Yes", "")
.Cells(12) = IIf(Len(RegExCheck(RegM, RegEx, _
"[\n\r](15:)")) > 0, "Yes", "")
.Cells(13) = IIf(Len(RegExCheck(RegM, RegEx, _
"[\n\r](16:)")) > 0, "Yes", "")
End With
Next
End If
Set RegEx = Nothing
Set RegC = Nothing
Set RegM = Nothing
End Sub
Function RegExCheck(ByVal vString As String, RegEx As RegExp, _
ByVal vPattern As String) As String
'check for a pattern match.. if match then return submatch,
' otherwise return blank
RegEx.Pattern = vPattern
If RegEx.Test(vString) Then
RegExCheck = RegEx.Execute(vString).Item(0).SubMatches(0)
End If
End Function[/vba]Don't hesitate to ask if you have any questions!
Matt

Ok, as I thought about it I realized you may not know the options for each file, so I create the sheet you're importing to and add the options programatically. Depending on the layout of the file they may be out of numerical order, but due to the complexity in sorting a string array like that by the numerical value at the beginning of the string I decided you can manually adjust the options columns if needed. Updated:[vba]Sub snoopies()
Dim vFile As String, vFF As Long, tempStr As String
Dim RegEx As Object, RegC As Object, RegM As Object
Dim vOptions() As String, Cnt As Long
vFile = "C:\FileA\FileA.txt"
vFF = FreeFile
Open vFile For Binary As #vFF
tempStr = Space$(LOF(vFF))
Get #vFF, , tempStr
Close #vFF
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
End With
ReDim vOptions(0)
Cnt = 0
If ActiveWorkbook Is Nothing Then
Workbooks.Add 1
Else
Sheets.Add
End If
Range("A1:G1").Value = Array("ISSUE DATE", "Time", "GROUP", "TYPE", _
"COPIES", "LEVEL", "RESTRICTION (DAYS)")
RegEx.Pattern = "[\n\r]\d+:[^\n\r]+"
If RegEx.Test(tempStr) Then
Set RegC = RegEx.Execute(tempStr)
For Each RegM In RegC
If InStrArray(vOptions, RegM) = False Then
ReDim Preserve vOptions(Cnt)
vOptions(Cnt) = RegM
Cnt = Cnt + 1
End If
Next

For Cnt = 0 To UBound(vOptions)
Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) = vOptions(Cnt)
vOptions(Cnt) = Replace(Replace(Replace(Replace(Replace( _
Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(vOptions(Cnt), "\", "\\"), "^", "\^"), "$", _
"\$"), "*", "\*"), "+", "\+"), "?", "\?"), ".", "\."), _
"(", "\("), ")", "\)"), "|", "\|"), "{", "\{"), "}", _
"\}"), ",", "\,")
Next
End If

RegEx.Pattern = "Product[^\x00]+?-----"
If RegEx.Test(tempStr) Then
Set RegC = RegEx.Execute(tempStr)
For Each RegM In RegC

With Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
.Cells(1) = RegExCheck(RegM, RegEx, _
"Date issued:([\d-]+)")
.Cells(2) = RegExCheck(RegM, RegEx, _
"Date issued:[\d-]+ ([\d:]+)")
.Cells(3) = RegExCheck(RegM, RegEx, _
"Issued to:([^\n\r]+)")
.Cells(4) = RegExCheck(RegM, RegEx, _
"Type=([^\n\r]+)")
.Cells(5) = RegExCheck(RegM, RegEx, _
"Copies=([^\n\r]+)")
.Cells(6) = RegExCheck(RegM, RegEx, _
"Level=([^\n\r]+)")
.Cells(7) = RegExCheck(RegM, RegEx, _
"Restriction=(\d+)")
For Cnt = 0 To UBound(vOptions)
.Cells(8 + Cnt) = IIf(Len(RegExCheck(RegM, _
RegEx, "[\n\r](" & vOptions(Cnt) & _
")")) > 0, "Yes", "")
Next
End With
Next
End If
Columns.AutoFit
Set RegEx = Nothing
Set RegC = Nothing
Set RegM = Nothing
End Sub
Function RegExCheck(ByVal vString As String, RegEx As RegExp, _
ByVal vPattern As String) As String
'check for a pattern match.. if match then return submatch,
' otherwise return blank
RegEx.Pattern = vPattern
If RegEx.Test(vString) Then
RegExCheck = RegEx.Execute(vString).Item(0).SubMatches(0)
End If
End Function
Function InStrArray(StrArray() As String, ByVal vString As String) As Boolean
Dim i As Long
For i = LBound(StrArray) To UBound(StrArray)
If StrArray(i) = vString Then
InStrArray = True
Exit Function
End If
Next
End Function[/vba]Matt

Hi Matt,

Thank you so much for your help, it's so great!

Also thanks for giving me the link to learn about RegEx. :rotlaugh: