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 <> ""
If (MyFilName = "." Or MyFilName = "..") 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, "=") + 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