• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 111
  • Last Modified:

Open and locate specific rows across several text files in VB6

I have a folder where each day a new log file is written of all the sites visited on a network.  Each file is written as a text file in the following format: 052214 (ie May 22, 2014)
On the code below, I am opening up a file to find out how many blocked sites occurred in one of the files.  Is it possible to specify a date range using two DTPicker controls and then open several files to find out how many blocked sites occurred?

As an example, I was select the beginning date and end date from May 22 to June 15
DTPicker1 = 052214
DTPicker2 = 061514

And then open all  24 files between those dates and find ALL the sites that were blocked.  Is this possible?

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

Open "C:\users\Alpesh\Desktop\052214.txt" 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
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

Open in new window

0
al4629740
Asked:
al4629740
  • 9
  • 8
1 Solution
 
jkaiosIT DirectorCommented:
Try this revised code (I added the For...Next loop and the related variables)

Dim iFiles as Integer, 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,"mmddyy")
sLastFile = Format(DTPicker2.Value,"mmddyy")

For iFiles = Val(sFirstFile) To Val(sLastFile)
   '// construct the current filename string
   sFile = "C:\users\Alpesh\Desktop\" & Format(iFiles,"000000") & ".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

Open in new window

0
 
jkaiosIT DirectorCommented:
You might have to reconsider naming your files to YYMMDD format for proper chronological ordering as MMDDYY will run into problems, such as when looping from December 31, 2014 thru January 2, 2015, for example.

123114
010215

The For...Next loop won't pass the above because 123114 (starting number) is greater than 010215.

But if putting the year first as in:

143112 to 150102, the loop will succeed because the ending number is greater than the starting number.
0
 
al4629740Author Commented:
What if I can't change the naming scheme.  Do I have any other options
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
al4629740Author Commented:
jkaios,

I get an "overflow" error on line 17
0
 
jkaiosIT DirectorCommented:
On line 1, change the iFiles variable type to Long.

Dim iFiles As Long

Open in new window

0
 
al4629740Author Commented:
Better.

But now it says subscript out of range on line 30.  Any ideas why that would happen?
0
 
jkaiosIT DirectorCommented:
What if I can't change the naming scheme.  Do I have any other options

Code below will circumvent the issue in your file naming convention.  The important logic is on lines 14, 15, 19.

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(sFile, 4) & Left(sFile, 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\" & 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

Open in new window

0
 
al4629740Author Commented:
I get "bad file name or number" error on line 23

sFile ends up getting a value of something that does not exist below.  Any ideas why it looks for txtC:.txt?
C:\users\Alpesh\Desktop\txtC:.txt
0
 
jkaiosIT DirectorCommented:
Sorry, change line 19 as follows:

sFile = Right(iFiles, 4) & Left(iFiles, 2)     'take the YY and put it at the end as in 140522 to 052214
0
 
al4629740Author Commented:
I get an error "subscript out of range" on line 34

Any ideas?

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

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

0
 
al4629740Author Commented:
I notice that this error when this error occurs.  After it analyzes the first file, it works fine.  When it finds the first new Blocked line in the next file, thats when the error "subscript out of range" on line 34 occurs.  

Any idea on how to resolve?
0
 
jkaiosIT DirectorCommented:
You have to increase the second dimension in your array variable to at least 1 or more.  So on line 26, change to something like this:

ReDim arrKeys(1, 1)

or

ReDim arrKeys(1, 2)
0
 
al4629740Author Commented:
That does not appear to solve the problem.  Any other ideas?

I still get the same error when changing it ReDim arrKeys(1,2)
0
 
jkaiosIT DirectorCommented:
The strParts array should be a zero-based so change to:

If arrKeys(1, lngLines) = strParts(0) Then
0
 
al4629740Author Commented:
Boy, I'm still getting the same error?  Have you tested this out also?  I get the "subscript out of range" error on line 34
0
 
jkaiosIT DirectorCommented:
I cannot test at my end because I don't have the data files.

Are you sure the error comes from line 34?

Can you provide a screen capture of the error after clicking the Debug button on the error message?
0
 
al4629740Author Commented:
see attached
error.docx
0

Featured Post

Independent Software Vendors: 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!

  • 9
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now