Sub Moncom()
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 = "c:\Power Readings\Monday\"
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|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
Else
.Pattern = "\b(IMax B1)(?=\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
myMax = myMax + Val(Split(myMatch(i + 1), vbTab)(ii))
Next
Exit For
End If
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
MsgBox "Compiling Completed Successfully"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
