VBS script out of range

the way i run this is parse.vbs info.txt and i keep getting a subscript out of range error. (i), i am not the best with vbs and needed some help, i greatly appreciate it, Thanks
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objFSO,objFile
Dim arrLines
Dim strLine
Dim objExcel,objWorkbook
Dim FileLoc
Dim intRow
Dim objDictionary

FileLoc = "C:\Users\ashields\Downloads\ipsec.xls"

Sub ExcelHeaders()
    Set objRange = objExcel.Range("A1","G1")
    objRange.Font.Size = 12
    objRange.Interior.ColorIndex=15

    objexcel.cells(1,1)="Filter Name"
    objexcel.cells(1,2)="Source"
    objexcel.cells(1,3)="Destination"
    objexcel.cells(1,4)="Source Port"
    objexcel.cells(1,5)="Destination Port"
    objexcel.cells(1,6)="Protocol"
    objexcel.cells(1,7)="Direction"
End Sub

Function RegExFind(strText,strPattern)
    Dim regEx
    Dim match, Matches
    Dim arrMatches
    Dim i : i = 0
    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = strPattern

    Set matches = regEx.Execute(strText)
    ReDim arrMatches(Matches.Count)
    For Each match In Matches
        For Each SubMatch In match.Submatches
            arrMatches(i) = Submatch
            i = i + 1
        Next
    Next
    RegExFind = arrMatches
End Function


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(WScript.Arguments(0),ForReading)

Set objExcel = CreateObject("excel.application")
Set objWorkbook = objExcel.Workbooks.Open(FileLoc)

objExcel.Visible = True

ExcelHeaders ' Create Excel Headers

rePolicy = "Policy Name\s+:\s(.+)"
reSRCAddr = "Source Address\s+:\s(.+)"
reDSTAddr = "Destination Address\s+:\s(.+)"
reProtocol = "Protocol\s+:\s(.+)"
reSRCPort = "Source Port\s+:\s(.+)"
reDSTPort = "Destination Port\s+:\s(.+)"
reDirection = "Direction\s+:\s(.+)"

strText = objFile.ReadAll
objFile.Close

Dim arrPolicy, arrSRCAddr, arrDSTAddr, arrProtocol, arrSRCPort, arrDSTPort, arrDirection

arrPolicy = RegExFind(strText, rePolicy)
arrSRCAddr = RegExFind(strText, reSRCAddr)
arrDSTAddr = RegExFind(strText, reDSTAddr)
arrProtocol = RegExFind(strText, reProtocol)
arrSRCPort = RegExFind(strText, reSRCPort)
arrDSTPort = RegExFind(strText, reDSTPort)
arrDirection = RegExFind(strText, reDirection)

intRow = 2

For i = 0 To UBound(arrPolicy)
    objExcel.Cells(introw,1) = arrPolicy(i)
    objExcel.Cells(introw,2) = arrSRCAddr(i)
    objExcel.Cells(introw,3) = arrDSTAddr(i)
    objExcel.Cells(introw,4) = arrSRCPort(i)
    objExcel.Cells(introw,5) = arrDSTPort(i)
    objExcel.Cells(introw,6) = arrProtocol(i)
    objExcel.Cells(introw,7) = arrDirection(i)

    intRow = intRow + 1
Next

objFile.Close
objWorkbook.save
'objExcel.Quit

Open in new window

info.txt
LVL 3
adamshieldsAsked:
Who is Participating?
 
JoeNuvoConnect With a Mentor Commented:
ok, try following change

strText = objFile.ReadAll
objFile.Close


change to be

strText = objFile.ReadAll
objFile.Close

strText = Replace(strText , "Src Port" , Char(13) & "Source Port")
strText = Replace(strText , "Dest Port", Char(13) & "Destination Port")

this should do the trick
0
 
JoeNuvoCommented:
Per your given info.txt,
It seem data to be found into each array will is not equal.
For ex, I couldn't find any of Source Port, Destination Port, Direction.

So, when you try to loop base on boundary of arrPolicy, you will encounter error from array of above mention search term.

Might need to check before put data into excel

for ex.

If i <= UBound(arrSRCPort) Then
   objExcel.Cells(introw,4) = arrSRCPort(i)
End If

Open in new window

0
 
RobSampsonCommented:
It looks like it will be due to the fact that you're not giving your arrMatches array enough room, because you're only giving it the Matches.Count, but assigning the SubMatches.Count, which will be more.

Try changing this:
    ReDim arrMatches(0)
    For Each match In Matches
        For Each SubMatch In match.Submatches
            arrMatches(i) = Submatch
            i = i + 1
        Next
    Next

Open in new window


to this:
    For Each match In Matches
        For Each SubMatch In match.Submatches
            i = i + 1
            ReDim Preserve arrMatches(i)
            arrMatches(i) = Submatch
        Next
    Next

Open in new window


Regards,

Rob.
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
adamshieldsAuthor Commented:
Rob with yours i am now getting  type mismatch arrMatches line 43, Joe where do i  insert your code, thanks
0
 
RobSampsonCommented:
OK, try this:

    Set matches = regEx.Execute(strText)
    For Each match In Matches
        For j = 0 To match.Submatches.Count
            i = i + 1
            ReDim Preserve arrMatches(i)
            arrMatches(i) = match.subMatches(j)
        Next
    Next

Open in new window


Regards,

Rob.
0
 
adamshieldsAuthor Commented:
nope still the same thing, Line 42 char13 type mismatch arrMatches
0
 
RobSampsonCommented:
OK, try this.

Regards,

Rob.
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objFSO,objFile
Dim arrLines
Dim strLine
Dim objExcel,objWorkbook
Dim FileLoc
Dim intRow
Dim objDictionary

FileLoc = "C:\Users\ashields\Downloads\ipsec.xls"

Sub ExcelHeaders()
    Set objRange = objExcel.Range("A1","G1")
    objRange.Font.Size = 12
    objRange.Interior.ColorIndex=15

    objexcel.cells(1,1)="Filter Name"
    objexcel.cells(1,2)="Source"
    objexcel.cells(1,3)="Destination"
    objexcel.cells(1,4)="Source Port"
    objexcel.cells(1,5)="Destination Port"
    objexcel.cells(1,6)="Protocol"
    objexcel.cells(1,7)="Direction"
End Sub

Function RegExFind(strText,strPattern)
    Dim regEx
    Dim match, Matches
    ReDim arrMatches(0)
    Dim i : i = 0
    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = strPattern

    Set matches = regEx.Execute(strText)
    For Each match In Matches
        For j = 0 To match.Submatches.Count - 1
            i = i + 1
            ReDim Preserve arrMatches(i)
            arrMatches(i) = match.subMatches(j)
        Next
    Next 
   	RegExFind = arrMatches
End Function


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(WScript.Arguments(0),ForReading)

Set objExcel = CreateObject("excel.application")
Set objWorkbook = objExcel.Workbooks.Open(FileLoc)

objExcel.Visible = True

ExcelHeaders ' Create Excel Headers

rePolicy = "Policy Name\s+:\s(.+)"
reSRCAddr = "Source Address\s+:\s(.+)"
reDSTAddr = "Destination Address\s+:\s(.+)"
reProtocol = "Protocol\s+:\s(.+)"
reSRCPort = "Source Port\s+:\s(.+)"
reDSTPort = "Destination Port\s+:\s(.+)"
reDirection = "Direction\s+:\s(.+)"

strText = objFile.ReadAll
objFile.Close

Dim arrPolicy, arrSRCAddr, arrDSTAddr, arrProtocol, arrSRCPort, arrDSTPort, arrDirection

arrPolicy = RegExFind(strText, rePolicy)
arrSRCAddr = RegExFind(strText, reSRCAddr)
arrDSTAddr = RegExFind(strText, reDSTAddr)
arrProtocol = RegExFind(strText, reProtocol)
arrSRCPort = RegExFind(strText, reSRCPort)
arrDSTPort = RegExFind(strText, reDSTPort)
arrDirection = RegExFind(strText, reDirection)

intRow = 2

For i = 0 To UBound(arrPolicy)

    If i <= UBound(arrPolicy) Then objExcel.Cells(intRow,1) = arrPolicy(i)
    If i <= UBound(arrSRCAddr) Then objExcel.Cells(intRow,2) = arrSRCAddr(i)
    If i <= UBound(arrDSTAddr) Then objExcel.Cells(intRow,3) = arrDSTAddr(i)
    If i <= UBound(arrSRCPort) Then objExcel.Cells(intRow,4) = arrSRCPort(i)
    If i <= UBound(arrDSTPort) Then objExcel.Cells(introw,5) = arrDSTPort(i)
    If i <= UBound(arrProtocol) Then objExcel.Cells(introw,6) = arrProtocol(i)
    If i <= UBound(arrDirection) Then objExcel.Cells(introw,7) = arrDirection(i)

    intRow = intRow + 1
Next

objFile.Close
objWorkbook.save
'objExcel.Quit

Open in new window

0
 
JoeNuvoCommented:
combine with bug pointing out by RobSampson
This is code for you to try

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objFSO,objFile
Dim arrLines
Dim strLine
Dim objExcel,objWorkbook
Dim FileLoc
Dim intRow
Dim objDictionary

FileLoc = "C:\Users\ashields\Downloads\ipsec.xls"

Sub ExcelHeaders()
    Set objRange = objExcel.Range("A1","G1")
    objRange.Font.Size = 12
    objRange.Interior.ColorIndex=15

    objexcel.cells(1,1)="Filter Name"
    objexcel.cells(1,2)="Source"
    objexcel.cells(1,3)="Destination"
    objexcel.cells(1,4)="Source Port"
    objexcel.cells(1,5)="Destination Port"
    objexcel.cells(1,6)="Protocol"
    objexcel.cells(1,7)="Direction"
End Sub

Function RegExFind(strText,strPattern)
    Dim regEx
    Dim match, SubMatch, Matches
    Dim arrMatches
    Dim i : i = 0
    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = strPattern

    Set Matches = regEx.Execute(strText)
    For Each match In Matches
        i = i + match.Submatches.Count
    Next

    ReDim arrMatches(i)
    i = 0
    For Each match In Matches
        For Each SubMatch In match.Submatches
            arrMatches(i) = SubMatch
            i = i + 1
        Next
    Next

    RegExFind = arrMatches
End Function


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(WScript.Arguments(0),ForReading)

Set objExcel = CreateObject("excel.application")
Set objWorkbook = objExcel.Workbooks.Open(FileLoc)

objExcel.Visible = True

ExcelHeaders ' Create Excel Headers

rePolicy = "Policy Name\s+:\s(.+)"
reSRCAddr = "Source Address\s+:\s(.+)"
reDSTAddr = "Destination Address\s+:\s(.+)"
reProtocol = "Protocol\s+:\s(.+)"
reSRCPort = "Source Port\s+:\s(.+)"
reDSTPort = "Destination Port\s+:\s(.+)"
reDirection = "Direction\s+:\s(.+)"

strText = objFile.ReadAll
objFile.Close

Dim arrPolicy, arrSRCAddr, arrDSTAddr, arrProtocol, arrSRCPort, arrDSTPort, arrDirection

arrPolicy = RegExFind(strText, rePolicy)
arrSRCAddr = RegExFind(strText, reSRCAddr)
arrDSTAddr = RegExFind(strText, reDSTAddr)
arrProtocol = RegExFind(strText, reProtocol)
arrSRCPort = RegExFind(strText, reSRCPort)
arrDSTPort = RegExFind(strText, reDSTPort)
arrDirection = RegExFind(strText, reDirection)

intRow = 2

For i = 0 To UBound(arrPolicy)
    objExcel.Cells(introw,1) = arrPolicy(i)
    If i <= UBound(arrSRCAddr) Then
        objExcel.Cells(introw,2) = arrSRCAddr(i)
    End If
    If i <= UBound(arrDSTAddr) Then
        objExcel.Cells(introw,3) = arrDSTAddr(i)
    End If
    If i <= UBound(arrSRCPort) Then
        objExcel.Cells(introw,4) = arrSRCPort(i)
    End If
    If i <= UBound(arrDSTPort) Then
        objExcel.Cells(introw,5) = arrDSTPort(i)
    End If
    If i <= UBound(arrProtocol) Then
        objExcel.Cells(introw,6) = arrProtocol(i)
    End If
    If i <= UBound(arrDirection) Then
        objExcel.Cells(introw,7) = arrDirection(i)
    End If

    intRow = intRow + 1
Next

objFile.Close
objWorkbook.save
'objExcel.Quit

Open in new window

0
 
adamshieldsAuthor Commented:
well it works but still has some other issues, when i have another info.txt file from a real server wilt alot more info,  it just stops at line 8 in excel, also the Source port and destination ports are not in the correct column, i cant send you the real info.txt file cause it has confidential data, why would this script just stop working? any ideas, there are times that within the info file the same ip address and server names etc... come up. do you think that is the issue?
0
 
JoeNuvoCommented:
try change this line

rePolicy = "Policy Name\s+:\s(.+)"

to be

rePolicy = "Filter name\s+:\s(.+)"

I guess this may help.
0
 
adamshieldsAuthor Commented:
Joe That Worked! now the only thing is now 3 things Protocol should be TCP and SRC port and DEST ports, currently the are all in the same column, any thoughts, Thanks so much for your help
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.