X82
09-24-2012, 06:56 AM
Sub test()
Dim myDir As String, fn As String, txt As String
Dim myMax As Double, myName As String, myLoc As String, n As Long
Dim myMatch As Object, x, y, temp As String, i As Long, ii As Long
myDir = ThisWorkbook.Path & "\"
fn = Dir(myDir & "*.txt")
If fn <> "" Then
n = n + 1
Sheets(1).Cells(n, 1).Resize(, 4).Value = _
[{"FileName","Name","Location","Max"}]
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
Do While fn <> ""
myName = Empty: myLoc = Empty: myMax = 0
txt = CreateObject("Scripting.FileSystemObject") _
.OpenTextFile(myDir & fn).ReadAll
.Global = True
.Pattern = "[^\n]+"
Set myMatch = .Execute(txt)
.Global = False
For i = 0 To myMatch.Count - 1
.Pattern = "\b(I(out)?Max( B1)?|Ph ?I(.A)?)(?=\t)"
If .test(myMatch(i)) Then
temp = .Execute(myMatch(i))(0)
x = Application.Match(temp, Split(myMatch(i), vbTab), 0)
myMax = Val(Split(myMatch(i + 1), vbTab)(x - 1))
Exit For
Else
.Pattern = "\b(IMax Ph1)(?=\t)"
If .test(myMatch(i)) Then
temp = .Execute(myMatch(i))(0)
x = Application.Match(temp, Split(myMatch(i), vbTab), 0)
For ii = x - 1 To x + 1
myMax = myMax + Val(Split(myMatch(i + 1), vbTab)(ii))
Next
Exit For
End If
End If
Next
.Pattern = "(\d{2}(?:[/\.])){2}\d{4}\t(\d{2}:){2}\d{2}\t[^\t]+\t([^\t]+)\t([^\t]+)"
If .test(txt) Then
myName = .Execute(txt)(0).submatches(2)
myLoc = .Execute(txt)(0).submatches(3)
End If
n = n + 1
Sheets(1).Cells(n, 1).Resize(, 4).Value = _
Array(fn, myName, myLoc, myMax)
fn = Dir
Loop
End With
Else
MsgBox "No file found"
End If
End Sub
I have a system of about 500 text files from our powerbar readings taken each night. I needed a script to run which would scan each of the text files, find a certain set of figures and put them into a spreadsheet. Above is what some kind soul did for me. It works beautifully, with one small problem which was my own. This (http://www.docs.google.com/folder/d/0B0U_dFIXO1labHBPaXZKMWlSUGs/edit)will take you to the 4 example files of the types of file this script will scan.
It works perfectly to pick up all red information (which you will see in the link above). The problem is ,with File 2, it must scan for the two figures in red, and add them together. But I forgot to explain this to the creator who is now away for a long period. With his code it will only add the 2nd digits in red, 1.9 from file 2. I have now correctly highlighted the first set of figures I need, in this case 1.8. I looked at the code over and over and don't know where to begin to modify myself to do this. With this complete it would be perfect!
Any ideas how I can modify this code slightly to fix this error? Any help on this matter is greatly appreciated.
Dim myDir As String, fn As String, txt As String
Dim myMax As Double, myName As String, myLoc As String, n As Long
Dim myMatch As Object, x, y, temp As String, i As Long, ii As Long
myDir = ThisWorkbook.Path & "\"
fn = Dir(myDir & "*.txt")
If fn <> "" Then
n = n + 1
Sheets(1).Cells(n, 1).Resize(, 4).Value = _
[{"FileName","Name","Location","Max"}]
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
Do While fn <> ""
myName = Empty: myLoc = Empty: myMax = 0
txt = CreateObject("Scripting.FileSystemObject") _
.OpenTextFile(myDir & fn).ReadAll
.Global = True
.Pattern = "[^\n]+"
Set myMatch = .Execute(txt)
.Global = False
For i = 0 To myMatch.Count - 1
.Pattern = "\b(I(out)?Max( B1)?|Ph ?I(.A)?)(?=\t)"
If .test(myMatch(i)) Then
temp = .Execute(myMatch(i))(0)
x = Application.Match(temp, Split(myMatch(i), vbTab), 0)
myMax = Val(Split(myMatch(i + 1), vbTab)(x - 1))
Exit For
Else
.Pattern = "\b(IMax Ph1)(?=\t)"
If .test(myMatch(i)) Then
temp = .Execute(myMatch(i))(0)
x = Application.Match(temp, Split(myMatch(i), vbTab), 0)
For ii = x - 1 To x + 1
myMax = myMax + Val(Split(myMatch(i + 1), vbTab)(ii))
Next
Exit For
End If
End If
Next
.Pattern = "(\d{2}(?:[/\.])){2}\d{4}\t(\d{2}:){2}\d{2}\t[^\t]+\t([^\t]+)\t([^\t]+)"
If .test(txt) Then
myName = .Execute(txt)(0).submatches(2)
myLoc = .Execute(txt)(0).submatches(3)
End If
n = n + 1
Sheets(1).Cells(n, 1).Resize(, 4).Value = _
Array(fn, myName, myLoc, myMax)
fn = Dir
Loop
End With
Else
MsgBox "No file found"
End If
End Sub
I have a system of about 500 text files from our powerbar readings taken each night. I needed a script to run which would scan each of the text files, find a certain set of figures and put them into a spreadsheet. Above is what some kind soul did for me. It works beautifully, with one small problem which was my own. This (http://www.docs.google.com/folder/d/0B0U_dFIXO1labHBPaXZKMWlSUGs/edit)will take you to the 4 example files of the types of file this script will scan.
It works perfectly to pick up all red information (which you will see in the link above). The problem is ,with File 2, it must scan for the two figures in red, and add them together. But I forgot to explain this to the creator who is now away for a long period. With his code it will only add the 2nd digits in red, 1.9 from file 2. I have now correctly highlighted the first set of figures I need, in this case 1.8. I looked at the code over and over and don't know where to begin to modify myself to do this. With this complete it would be perfect!
Any ideas how I can modify this code slightly to fix this error? Any help on this matter is greatly appreciated.