Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Text, VB and Access 1

Status
Not open for further replies.

jimee

Programmer
Mar 27, 2001
1
US
I need to know how to write some code to open 300 fixed width txt files and extract some lines out of each file to be imported into a database. The database has been created. I need to automate the opening of the text file, the extraction and the importing on all three hundred files. Here is a sample of one file. Each file has 15 pens and all 15 have the following info....

BEGIN_COLOR = 3
PEN_NUMBER = 3
HW_LINETYPE = 0
PEN_SPEED = 1
PEN_WEIGHT = 0.004000
END_COLOR


I need the file name, Pen_number and Pen_Width as my fields.

 
I am assuming that the values are on seperate lines in the file and that they are seperated by a carriage return line feed combination. I am also assuming tht Pen_Width is the same as PEN_WEIGHT.
With that assumption, here is a solution . . .



Dim intIndex as integer
Dim intFileHandle as integer
Dim vntFileData as variant
Dim strLineLabel as string
Dim strData as string
dim intPos as integer


'** Get a filehandle.

intFileHandle = freefile


'** Read all of the data from the file in 1 read. and
'** then close the file right away.

open {filepath} for Binary as intFileHandle
vntFileData = Input(lof(intFileHandle),intFileHandle)
close intFileHandle


'** Break the single line up into an array. 1 cell for
'** each seperate line

vntFileData = split(vntFileData,vbCrLf)

if isarray(vntFileData) then
for intIndex = 0 to ubound(vntFileData)

strLineLabel =Ucase$(trim$(vntFileData(intIndex)))
intPos = instr(1,strLineLabel,"=")

Select case true

case left$(strLineLabel,9) = "PEN_SPEED"

strData = mid$(strLineData, intPos+1)

'** This is your data . . . write it
'** out to your database.


Case left$(strLineLabel,10) = "PEN_WEIGHT"

strData = mid$(strLineData, intPos+1)

'** This is your data . . . write it
'** out to your database.


end select

next intIndex
end if



Now, simply call this code for each of the files that you need to scan. And remember to write the data out as it is found. Hope this helps! :)

- Jeff Marler
(please note, that the page is under construction)
 
Some thoughts on this.

First, If you need to go throught the process, why not get all of the data items. someone will surely want something else before you are done.

Second, are all of the file names "identifiable" through a pattern (All like "*.Pen") and within a single directory? If so this is pretty easy, otherwise getting the correct set of files will be the hard part.

The below WILL need some changes. the least of these will be to substitute the correct names for various objects such as path, file name extension, recordset (table) name, field names ...

Then, you will probably find my off the top errs in syntax ...

On the otherhand, it is at least a "skeleton" of what you are asking for.





Code:
Public Sub basGetPenInfo()

    'Each file has 15 pens and all 15 have the following info....

    'BEGIN_COLOR = 3
    'PEN_NUMBER = 3
    'HW_LINETYPE = 0
    'PEN_SPEED = 1
    'PEN_WEIGHT = 0.004
    'END_COLOR

    'I need the file name, Pen_number and Pen_Width as my fields.

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    Dim MyFil As Integer
    Dim MyFilName As String
    Dim Begcolor As Integer
    Dim PenNum As Integer
    Dim LinTyp As Integer
    Dim PenSpd As Integer
    Dim PenWt As Single
    Dim LineIn As String

    Dim Identifiers(5) As String
    Identifier(0) = "BEGIN_COLOR"
    Identifier(1) = "PEN_NUMBER"
    Identifier(2) = "HW_LINETYPE"
    Identifier(3) = "PEN_SPEED"
    Identifier(4) = "PEN_WEIGHT"
    Identifier(5) = "END_COLOR"

    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("MyTableNameHere", dbOpenDynaset)

    Dim MyPath As String
    MyPath = "C:\My Documents\PenIds\"

    MyFilName = Dir(MyPath & "*.Pen")
    While MyFilName <> &quot;&quot;
        If (MyFilName = &quot;.&quot; Or MyFilName = &quot;..&quot;) Then
            GoTo NotPen
        End If
        
        MyFil = FreeFile
        Open MyFileName For Input As #MyFil
        While Not EOF(MyFil)
            Line Input #MyFil, LineIn
            
            For Idx = 0 To UBound(Identifiers)
                LineId = InStr(LineIn, Identifiers(Idx))
            Next Idx
            If (LineId > 5) Then
                'Not a line we want / need
                GoTo NxtLine
            End If

            Delim = Len(LineIn) - InStr(LineIn, &quot;=&quot;) + 1
            LineVal = Trim(right(LineIn, Delim))
            Select Case LineId
                Case Is = 0         'Begin_Color
                    'Not Required

                Case Is = 1         'PEN_NUMBER
                    'Required
                    PenNum = Trim(right(LineIn, Delim))

                Case Is = 2         'HW_LINETYPE
                    'Not Required
                    LinTyp = Trim(right(LineIn, Delim))

                Case Is = 3         'PEN_SPEED
                    'Not Required
                    PenSpd = Trim(right(LineIn, Delim))

                Case Is = 4         'PEN_WEIGHT
                    'Required
                    PenWt = Trim(right(LineIn, Delim))

                Case Is = 5         'END_COLOR
                    'Not Required, bt used as the Record Indicator
                    rst.AddNew
                        rst!FilName = MyFileName
                        rst!PenNum = PenNum
                       ' rst!LinTyp = LinTyp
                       ' rstPenSpd = PenSpd
                        rst!PenWt = PenWt
                    rst.Update

            End Select

NxtLine:
        Wend

NotPen:
        MyFilName = Dir
    Wend

End Sub
MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top