Read text file

Posted on 2004-03-24
Last Modified: 2012-05-04
Sorry i haven't many more points left, so it is only going to be 135.


What i want to do is read every file .txt in a directory eg, c:\text\*.*

Each file is uniquely numbered.

124textfile.txt   etc etc

Inside each text file is the following:

 | (0008,0022) : DA   Len: 8      AcquisitionDate                Value: [20020121]
 | (0008,0029) : DA   Len: 8      AcquisitionTime                Value: [20020121]

this can have LOADS of lines,

what i want for example is to find the line with the number 0008,0022 and copy the value  "20020121" into a SQL database, using also the file name as the entry.

However i want to add more than 1 into the database so i could say........................

Copy 0001,0034 and 0022,4733, and also 1234,4443 data into database,

Please guide me into the right direction, just to end up with the var of the result for example at least.

More points will be awarded as i get them

Question by:bolox
LVL 67

Accepted Solution

sirbounty earned 54 total points
ID: 10667422
Place this in a sub:

Do while x < 150 'or whatever # you need to stop at
    Open ("C:\text\" & x & "textfile.txt") for input as #1
    do while not eof(1)
        line input #1, strData
        'one of these two methods should work (or both) - your preference
        if instr(1,strData, "0008,0022") > 0 then strResults=strResults & "," & left(right(strData,9),8)
        'if left(strData,12)="| (0008,0022" then strResults=strResults & "," & left(right(strData,9),8)

This should create one string (strResults) with your data (20020121,20020121, [...])

LVL 28

Assisted Solution

vinnyd79 earned 53 total points
ID: 10668025
you could try a select case statement:

Private Sub Command1_Click()
Dim FileName As String, DirName As String, Ln As String
Dim ff As Integer, pos As Integer, pos2 As Integer
Dim arrVal() As String

DirName = "C:\text\"
FileName = Dir(DirName & "*.txt")

While FileName <> ""

    ff = FreeFile
    Open DirName & FileName For Input As #ff
    Do Until EOF(ff)
    Line Input #ff, Ln
    If Trim$(Ln) = "" Then GoTo GetNext
    pos = InStr(Ln, "(") + 1
    Select Case Mid$(Ln, pos, InStr(pos, Ln, ")") - pos)
        Case "0001,0034"
            arrVal = Split(Ln, "Value:")
            pos2 = InStr(arrVal(1), "[") + 1
            MsgBox DirName & FileName
            MsgBox Mid$(arrVal(1), pos2, InStr(pos2, arrVal(1), "]") - pos2)
        Case "0022,4733"
            arrVal = Split(Ln, "Value:")
            pos2 = InStr(arrVal(1), "[") + 1
            MsgBox DirName & FileName
            MsgBox Mid$(arrVal(1), pos2, InStr(pos2, arrVal(1), "]") - pos2)
    End Select

    FileName = Dir


End Sub
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 10668079
You said each file is uniquely numbered, but is each line in the files uniquely numbered?  Can there be more than one line with 0008,0022 on it per file?  Could 0008,0022 appear in more than one file?

The numbers appear to be sequential.  Is this always true?  Are the values you are looking for given to you in a sequential order?

The answers to these questions can help us develop a more efficient searching algorithm.


Author Comment

ID: 10668567
Each file will only have ONE 0012,0012 for example, however they may not have one altogether.

LInes numbers are not possible, as not all lines are present.
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

LVL 85

Expert Comment

by:Mike Tomlinson
ID: 10670614
Is it possible for 0012,0012  to be in say 123textfile.txt and 124textfile.txt at the same time?

I was thinking you could parse each line in each file and add each value to a collection using the number as the key.  Then you can do as many lookups as you want really quickly.

It would take memory to hold the all the data at once but if you are doing a lot of searches I think it would be faster then searching the files themselves each time.

Let me know if you want to see the code to do this.


Author Comment

ID: 10676238
Each file will generally have the same contents (except value is different)

However some may have a line missing altogether

LVL 85

Expert Comment

by:Mike Tomlinson
ID: 10677635
Here is an example of how to store all the value / key combinations in a collection.

Create a new project and add two commandbuttons.

When the first button is pressed the app will process all text files it finds in the hard coded path.

The second button demonstrates how to do a key lookup and iterate throuhg all the returned values (if any).



' ------------------------------------------------------------------------------------------------------

Option Explicit

Private files As New Collection

Private Sub Command1_Click()
    ' Read all txt files in path and add their value/key combinations to our collection
    Dim matchingFiles As New Collection
    Dim matchedFile As Variant
    Dim path As String, pattern As String
    path = "C:\Documents and Settings\Tomlinson\My Documents\1 VB Code\Convert All Files In Directory\"
    pattern = "*.txt"
    Set matchingFiles = getFilesInDirectory(path, pattern)
    For Each matchedFile In matchingFiles
        addFileContents path & matchedFile
    Next matchedFile
End Sub

Private Sub Command2_Click()
    ' demonstrates how to lookup all values for a given key
    Dim values As Collection
    Dim value As Variant
    Dim key As String
    key = "0008,0022"
    Debug.Print "Key: " & key
    For Each value In getValuesFromKey(key)
        Debug.Print "Value: " & value
        ' do something with your value / key combo here
    Next value
End Sub

Private Function getFilesInDirectory(targetDirectory As String, filePattern As String) As Collection
    ' generic function to return a collection of filenames in the targetDirectory
    ' that match the filePattern
    Dim fileCollection As New Collection
    Dim curFile As String
    On Error GoTo noSuchDirectory
    ChDir targetDirectory
    On Error GoTo 0
    curFile = Dir(filePattern)
    Do Until curFile = ""
        fileCollection.Add curFile, curFile
        curFile = Dir()
    Set getFilesInDirectory = fileCollection
    Exit Function
    MsgBox "Invalid Directory: " & targetDirectory
    Set getFilesInDirectory = fileCollection
End Function

Private Sub addFileContents(fileName As String)
    ' read fileName and add value/key combinations to a collection
    ' when done, add the collection to our global files collection
    On Error Resume Next ' possible duplicate key errors
    Dim fileContents As New Collection
    Dim ff As Integer
    Dim inputLine As String
    Dim key As String
    Dim value As String
    Dim leftParen As Integer
    Dim rightParen As Integer
    Dim leftBracket As Integer
    Dim rightBracket As Integer
    If Dir(fileName) <> "" Then
        Debug.Print "Reading " & fileName
        ff = FreeFile
        Open fileName For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, inputLine
' | (0008,0022) : DA   Len: 8      AcquisitionDate                Value: [20020121]
            leftParen = InStr(inputLine, "(")
            rightParen = InStr(inputLine, ")")
            leftBracket = InStr(inputLine, "[")
            rightBracket = InStr(inputLine, "]")
            key = Mid(inputLine, leftParen + 1, rightParen - leftParen - 1)
            value = Mid(inputLine, leftBracket + 1, rightBracket - leftBracket - 1)
            Debug.Print "Added " & key & " = " & value
            fileContents.Add value, key
        Close #ff
    End If
    If fileContents.Count > 0 Then
        files.Add fileContents
    End If
    Set fileContents = Nothing
End Sub

Private Function getValuesFromKey(keyValue As String) As Collection
    ' search all the stored value/key combinations and
    ' return a collection containing all values matching that given key
    On Error GoTo noSuchLine
    Dim valuesCollection As New Collection
    Dim file As Variant
    Dim value As Variant
    For Each file In files
        value = file.Item(keyValue)
        valuesCollection.Add value
    Next file
    Set getValuesFromKey = valuesCollection
    Exit Function

    Resume skipLine
End Function

Author Comment

ID: 10702787
OK, i have reduced the task by use of the following code:

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        If TextBox1.Text <> "" Then

            Dim oDirectory As New IO.DirectoryInfo(TextBox1.Text)
            Dim oListing As IO.FileInfo() = oDirectory.GetFiles("*.dmp")
            Dim oFileName As IO.FileInfo
            Dim Text, FoundEnd, FullPath, Search As String
            Dim TotalFiles, FilesOpened, Found, linecount As Integer
            TotalFiles = oListing.Length()

            Search = "1"

            ProgressBar1.Maximum = Int(TotalFiles)

            For Each oFileName In oListing

                'Add 1 block to the Progress Bar
                FilesOpened = FilesOpened + 1
                ProgressBar1.Value = FilesOpened

                FullPath = oDirectory.FullName & "\" & oFileName.Name

                Dim oRead As IO.TextReader = IO.File.OpenText(FullPath)


                    If InStr(oRead.ReadLine, "(0010,0010)", CompareMethod.Binary) > 0 Then
                        ListBox2.Items.Add(oFileName.Name & "-" & FilesOpened & "----" & oRead.ReadLine)
                    End If

                    FoundEnd = InStr(1, "END-OF-DATASET", oRead.ReadLine, CompareMethod.Text)

                Loop Until FoundEnd > 0
            MessageBox.Show(FilesOpened & " Files opened")
            MessageBox.Show("Directory not set")
        End If

    End Sub

When displaying the result it writes out the NEXT line in the text file????
So instead of displaying the line containing 0010,0010 is displays for example 0010,0011

? Please helpsBTW, The points are slowly going up 4 u all.

Thankyou for your help so far
LVL 85

Assisted Solution

by:Mike Tomlinson
Mike Tomlinson earned 53 total points
ID: 10704199
It reads the next line because you put .ReadLine in the code to add the current line to your ListBox.  You need to store the currentLine in a String and use the string variable in your InStr checks.

    If InStr(oRead.ReadLine, "(0010,0010)", CompareMethod.Binary) > 0 Then
        ListBox2.Items.Add(oFileName.Name & "-" & FilesOpened & "----" & oRead.ReadLine) '   <-----  Error Here!!!
    End If

So it needs to look more like this:

    Dim curLine As String


    curLine = oRead.ReadLine
    If InStr(curLine, "(0010,0010)", CompareMethod.Binary) > 0 Then
        ListBox2.Items.Add(oFileName.Name & "-" & FilesOpened & "----" & curLine)
    End If



Featured Post

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.

Join & Write a Comment

Introduction In a recent article ( for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
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…

760 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

20 Experts available now in Live!

Get 1:1 Help Now