Solved

subscript out of range error - looping error

Posted on 2014-11-24
10
114 Views
Last Modified: 2014-11-25
I have a folder on my computer where log files are kept for internet browsing.  The naming convention for those files are in a date format.  (attached)

When  I select a date range from my vb6 (DTPicker1,DTPicker2) form, the code below searches through those files looking for any lines containing the string "BlockedIP".  When I select a date range of only one day, the code below works fine.  However when I select more than one day such as 112314 to 112414, then I get the error "subscript out of range" on line 34.  

What issue am I facing with the loop?  Any ideas on resolving?

Thanks Much


Private Sub Command2_Click()
Dim iFiles As Long, sFirstFile$, sLastFile$, sFile$
Dim f As Integer
Dim strLine As String
Dim lngLines As Long
Dim arrKeys() As String
Dim bFound As Boolean
Dim bFirst As Boolean
Dim intCount As Integer
Dim strParts() As String
Dim intTot As Integer
bFirst = True
f = FreeFile

sFirstFile = Format(DTPicker1.Value, "yymmdd")  'May 22, 2014  = 140522
sLastFile = Format(DTPicker2.Value, "yymmdd")   'June 15, 2014 = 140615

For iFiles = Val(sFirstFile) To Val(sLastFile)  'loop will proceed if starting number <= ending number
   ' this is required since we're reading the YY first...
   sFile = Right(iFiles, 4) & Left(iFiles, 2)     'take the YY and put it at the end as in 140522 to 052214
   '// now construct the current filename FQN
   sFile = "C:\users\Alpesh\Desktop\test\" & sFile & ".txt"
   '// skip to the next file loop if current file does not exist
   If (Dir(sFile) <> "") Then
      Open sFile For Input As #f
      ReDim arrKeys(1, 0)
      Do Until EOF(f)
         Line Input #f, strLine
         bFound = False
         If InStr(strLine, "BlockedIP") > 0 Then
            intTot = intTot + 1
            strParts = Split(strLine, "keyword")
            For lngLines = 0 To intCount - 1
               If arrKeys(1, lngLines) = strParts(1) Then
                  arrKeys(0, intCount - 1) = arrKeys(0, intCount - 1) + 1
                  bFound = True
                  Exit For
               End If
            Next
            If Not bFound Then
               If Not bFirst Then
                  ReDim Preserve arrKeys(1, intCount)
               End If
               arrKeys(1, intCount) = strParts(1)
               arrKeys(0, intCount) = 1
               bFirst = False
               intCount = intCount + 1
            End If
         End If
      Loop
      Close
   End If
Next iFiles

Dim intIW As Integer
For lngLines = 0 To intCount - 1
    Debug.Print arrKeys(0, lngLines) & "-" & arrKeys(1, lngLines)
    intIW = intIW + arrKeys(0, lngLines)
Next
Debug.Print "Total number found " & intTot
Debug.Print "Total reported "; intIW
End Sub

Open in new window

112414.txt
112314.txt
0
Comment
Question by:al4629740
[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
  • 3
  • 2
  • +1
10 Comments
 
LVL 11

Expert Comment

by:Dany Balian
ID: 40463393
from a quick read.. here's what i noticed
you are forgetting to reset your variables at the beginning of the loop (these variables are important to redim your array)
just add these and your code will work:
bFound = False
bFirst = True
intCount = 0

Private Sub Command2_Click()
Dim iFiles As Long, sFirstFile$, sLastFile$, sFile$
Dim f As Integer
Dim strLine As String
Dim lngLines As Long
Dim arrKeys() As String
Dim bFound As Boolean
Dim bFirst As Boolean
Dim intCount As Integer
Dim strParts() As String
Dim intTot As Integer
bFirst = True
f = FreeFile

sFirstFile = Format(DTPicker1.Value, "yymmdd")  'May 22, 2014  = 140522
sLastFile = Format(DTPicker2.Value, "yymmdd")   'June 15, 2014 = 140615

For iFiles = Val(sFirstFile) To Val(sLastFile)  'loop will proceed if starting number <= ending number
   ' this is required since we're reading the YY first...
   sFile = Right(iFiles, 4) & Left(iFiles, 2)     'take the YY and put it at the end as in 140522 to 052214
   '// now construct the current filename FQN
   sFile = "C:\users\Alpesh\Desktop\test\" & sFile & ".txt"
   '// skip to the next file loop if current file does not exist
   If (Dir(sFile) <> "") Then
      Open sFile For Input As #f
      ReDim arrKeys(1, 0)
      Do Until EOF(f)
         Line Input #f, strLine
         bFound = False
         bFirst = True
         intCount = 0
         If InStr(strLine, "BlockedIP") > 0 Then
            intTot = intTot + 1
            strParts = Split(strLine, "keyword")
            For lngLines = 0 To intCount - 1
               If arrKeys(1, lngLines) = strParts(1) Then
                  arrKeys(0, intCount - 1) = arrKeys(0, intCount - 1) + 1
                  bFound = True
                  Exit For
               End If
            Next
            If Not bFound Then
               If Not bFirst Then
                  ReDim Preserve arrKeys(1, intCount)
               End If
               arrKeys(1, intCount) = strParts(1)
               arrKeys(0, intCount) = 1
               bFirst = False
               intCount = intCount + 1
            End If
         End If
      Loop
      Close
   End If
Next iFiles

Dim intIW As Integer
For lngLines = 0 To intCount - 1
    Debug.Print arrKeys(0, lngLines) & "-" & arrKeys(1, lngLines)
    intIW = intIW + arrKeys(0, lngLines)
Next
Debug.Print "Total number found " & intTot
Debug.Print "Total reported "; intIW
End Sub

Open in new window

0
 
LVL 12

Expert Comment

by:jkaios
ID: 40463435
the "strParts" variable is declared as a zero-based, one-dimensional array on line 10, and line 32
  Dim strParts() As String
   strParts = Split(....)          <<-- this function returns a zero-based array

so on line 34, the subscript should be zero, not one.
   If arrKeys(1, lngLines) = strParts(0) Then
0
 
LVL 14

Expert Comment

by:ThomasMcA2
ID: 40463501
Because you are using integers to control your loop, your program can only process 32,767 lines from your logs. Because of that small size limit, I never use integers. I always use "long" data types, which have a maximum value of 2,147,483,647.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:al4629740
ID: 40463622
Dany,

Your solution seems to work best.  

The output is (which is correct)
Total number found 44
Total reported  0

However, it no longer outputs the actual sites that were blocked.  For example, it would output all the 44 sites that were found and how many times each site was blocked.  See below.  Any ideas why resetting the variables is causing that?

Total number found 44
Total reported  0
7- adnxs.com: ib.adnxs.com. -> 192.168.1.100
1207- blogspot.com: adsense.blogspot.com. -> 192.168.1.100
20- visualwebsiteoptimizer.com: dev.visualwebsiteoptimizer.com. -> 192.168.1.100
41- ^.*s(3|e)x: expertsexchange.112.2o7.net. -> 192.168.1.100
389- ^.*\.(asp|aspx|htm|html|jsp|php|xml)-: www.xml-sitemaps.com. -> 192.168.1.100
1- adsrvr.org: match.adsrvr.org. -> 192.168.1.100
etc.....
0
 
LVL 12

Expert Comment

by:jkaios
ID: 40463639
The "intIW" variable is not being incremented in the loop because the loop didn't run, thus the zero result.

So the For...Next loop on line 58 should reference the intTot variable instead of intCount.  

Change:

For lngLines = 0 To intCount - 1

Open in new window


To:
For lngLines = 0 To intTot - 1

Open in new window

0
 

Author Comment

by:al4629740
ID: 40463809
After changing it to
For lngLines = 0 To intTot - 1

I get subscript out of range error on line 59.  Do I need to reset the variables also in this case before entering the loop?
0
 
LVL 11

Expert Comment

by:Dany Balian
ID: 40463969
Can u try my code plz? I tested it in vb6 it works
0
 
LVL 11

Accepted Solution

by:
Dany Balian earned 500 total points
ID: 40464164
oh wait, i found another mistake you've done! you are redimming the arrkey inside the loop, it should be taken outside of the loop..

try this please:

Private Sub Command2_Click()
Dim iFiles As Long, sFirstFile$, sLastFile$, sFile$
Dim f As Integer
Dim strLine As String
Dim lngLines As Long
Dim arrKeys() As String
Dim bFound As Boolean
Dim bFirst As Boolean
Dim intCount As Integer
Dim strParts() As String
Dim intTot As Integer
bFirst = True
f = FreeFile

sFirstFile = Format(DTPicker1.Value, "yymmdd")  'May 22, 2014  = 140522
sLastFile = Format(DTPicker2.Value, "yymmdd")   'June 15, 2014 = 140615
intCount = 0
ReDim arrKeys(1, 0)
For iFiles = Val(sFirstFile) To Val(sLastFile)  'loop will proceed if starting number <= ending number
   ' this is required since we're reading the YY first...
   sFile = Right(iFiles, 4) & Left(iFiles, 2)     'take the YY and put it at the end as in 140522 to 052214
   '// now construct the current filename FQN
   sFile = "C:\users\Alpesh\Desktop\test\" & sFile & ".txt"
   '// skip to the next file loop if current file does not exist
    
      If (Dir(sFile) <> "") Then
      Open sFile For Input As #f
      Do Until EOF(f)
         Line Input #f, strLine
         bFound = False
         If InStr(strLine, "BlockedIP") > 0 Then
            intTot = intTot + 1
            strParts = Split(strLine, "keyword")
            For lngLines = 0 To intCount - 1
               If arrKeys(1, lngLines) = strParts(1) Then
                  arrKeys(0, lngLines) = arrKeys(0, lngLines) + 1
                  bFound = True
                  Exit For
               End If
            Next
            If Not bFound Then
               If Not bFirst Then
                  ReDim Preserve arrKeys(1, intCount)
               End If
               arrKeys(1, intCount) = strParts(1)
               arrKeys(0, intCount) = 1
               bFirst = False
               intCount = intCount + 1
            End If
         End If
      Loop
      Close
   End If
Next iFiles

Dim intIW As Integer
For lngLines = 0 To intCount - 1
    Debug.Print arrKeys(0, lngLines) & "-" & arrKeys(1, lngLines)
    intIW = intIW + arrKeys(0, lngLines)
Next
Debug.Print "Total number found " & intTot
Debug.Print "Total reported "; intIW
End Sub

Open in new window


EDIT: refixed the code!
0
 

Author Comment

by:al4629740
ID: 40464634
Dany, YOU GOT IT!!!!!
0
 
LVL 11

Expert Comment

by:Dany Balian
ID: 40464651
Glad i could help :)
0

Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
JSON Response and request in VB6 application 11 1,067
Excel - Save a copy of work book 13 96
Visual Studio 2005 text editor 10 56
SQL Server 2012 to SQL Server 2016 24 57
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

752 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