?
Solved

VBS script out of range

Posted on 2011-03-22
11
Medium Priority
?
588 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:adamshields
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
  • 3
11 Comments
 
LVL 11

Expert Comment

by:JoeNuvo
ID: 35195924
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35195937
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
 
LVL 3

Author Comment

by:adamshields
ID: 35195967
Rob with yours i am now getting  type mismatch arrMatches line 43, Joe where do i  insert your code, thanks
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 65

Expert Comment

by:RobSampson
ID: 35195987
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
 
LVL 3

Author Comment

by:adamshields
ID: 35196005
nope still the same thing, Line 42 char13 type mismatch arrMatches
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35196085
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
 
LVL 11

Expert Comment

by:JoeNuvo
ID: 35196102
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
 
LVL 3

Author Comment

by:adamshields
ID: 35196135
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
 
LVL 11

Expert Comment

by:JoeNuvo
ID: 35196142
try change this line

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

to be

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

I guess this may help.
0
 
LVL 3

Author Comment

by:adamshields
ID: 35196164
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
 
LVL 11

Accepted Solution

by:
JoeNuvo earned 2000 total points
ID: 35196205
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

Featured Post

Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Know what services you can and cannot, should and should not combine on your server.
This article will inform Clients about common and important expectations from the freelancers (Experts) who are looking at your Gig.
Simple Linear Regression
Introduction to Processes
Suggested Courses

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question