?
Solved

Open and locate specific rows across several text files in VB6

Posted on 2014-11-17
17
Medium Priority
?
110 Views
Last Modified: 2014-11-24
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
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
  • 9
  • 8
17 Comments
 
LVL 12

Accepted Solution

by:
jkaios earned 1500 total points
ID: 40449060
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
 
LVL 12

Expert Comment

by:jkaios
ID: 40449069
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
 

Author Comment

by:al4629740
ID: 40449071
What if I can't change the naming scheme.  Do I have any other options
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.

 

Author Comment

by:al4629740
ID: 40449073
jkaios,

I get an "overflow" error on line 17
0
 
LVL 12

Expert Comment

by:jkaios
ID: 40449078
On line 1, change the iFiles variable type to Long.

Dim iFiles As Long

Open in new window

0
 

Author Comment

by:al4629740
ID: 40449081
Better.

But now it says subscript out of range on line 30.  Any ideas why that would happen?
0
 
LVL 12

Expert Comment

by:jkaios
ID: 40449096
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
 

Author Comment

by:al4629740
ID: 40450142
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
 
LVL 12

Expert Comment

by:jkaios
ID: 40450935
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
 

Author Comment

by:al4629740
ID: 40451409
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
 

Author Comment

by:al4629740
ID: 40451592
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
 
LVL 12

Expert Comment

by:jkaios
ID: 40451654
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
 

Author Comment

by:al4629740
ID: 40453996
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
 
LVL 12

Expert Comment

by:jkaios
ID: 40454320
The strParts array should be a zero-based so change to:

If arrKeys(1, lngLines) = strParts(0) Then
0
 

Author Comment

by:al4629740
ID: 40456527
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
 
LVL 12

Expert Comment

by:jkaios
ID: 40456610
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
 

Author Comment

by:al4629740
ID: 40456646
see attached
error.docx
0

Featured Post

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!

Question has a verified solution.

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

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month15 days, 2 hours left to enroll

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