Solved

VBS script out of range

Posted on 2011-03-22
11
572 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
  • 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
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

 
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 500 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

NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
How to get all the API from website? 11 82
Server 2012 management. 5 23
Help Required 2 29
vbscript to installing all steps of softwares automatically 7 18
Issue: One Windows 2008 R2 64bit server on the network unable to connect to a buffalo Device (Linkstation) with firmware version 1.56. There are a total of four servers on the network this being one of them. Troubleshooting Steps: Connect via h…
This article will inform Clients about common and important expectations from the freelancers (Experts) who are looking at your Gig.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

813 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now