Solved

Open and locate specific rows across several text files in VB6

Posted on 2014-11-17
17
99 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
  • 9
  • 8
17 Comments
 
LVL 12

Accepted Solution

by:
jkaios earned 500 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
 

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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
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 Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

759 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

22 Experts available now in Live!

Get 1:1 Help Now