Tom,
No missing references when I go to Tools >> References, although
there must be a least 100 boxes on the left not checked. See code
below as well as the data file attached. For some reason I couldn't
attach a file. Data is at the bottom, one line and two fields from the
second line. Note in Word I see a backwards P between lines.
Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Long
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Long
Dim NextPos As Long
Dim SaveColNdx As Long
Dim ColState As Long
Dim RowHeading As Long
Dim ColHeading As Long
Dim CCount As Long
Dim C2Count As Long
Dim FieldNum As Long
Dim CellToSave As Long
Dim EndOfCol As Long
Dim EndOfRow As Long
'Application.ScreenUpdating = False
'On Error GoTo EndMacro:
'
'SaveColNdx = ActiveCell.Column
'RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1
RowNdx = 2
ColNdx = 1
CCount = 2
C2Count = 1
FieldNum = 1
CellToSave = 2
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While (FieldNum >= 1)
If (FieldNum < 6) Then
' ******************************************************
' TempVal is the data in a particular field
' WholeLine contains the entire line of data, text, numbers and commas
' Pos contains the first character of a field in a string
' NextPos contains the location of the comma separated fields
' The first part of the IF statement really does nothing. All the
horsepower
' is in the Else of the IF statement
' ******************************************************
TempVal = VBA.Mid(WholeLine, Pos, NextPos - Pos)
Pos = NextPos + 1
NextPos = InStr(Pos, WholeLine, Sep)
FieldNum = FieldNum + 1
Else
If (CellToSave = 2) Then
TempVal = VBA.Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, 1).Value = TempVal
Pos = NextPos + 1
NextPos = InStr(Pos, WholeLine, Sep)
FieldNum = FieldNum + 1
CellToSave = 1
RowNdx = RowNdx + 1
Else
TempVal = VBA.Mid(WholeLine, Pos, NextPos - Pos)
Pos = NextPos + 1
NextPos = InStr(Pos, WholeLine, Sep)
FieldNum = FieldNum + 1
CellToSave = 2
End If
If RowNdx > (65500) Then GoTo EndMacro
End If
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
Public Sub DoTheImport()
Dim FName As Variant
Dim Sep As String
FName = Application.GetOpenFilename(filefilter:="Text
Files(*.dat),*.dat,All Files (*.*),*.*")
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If
Sep = ","
ImportTextFile CStr(FName), Sep
End Sub
Data: 0,89fdvnm161170304,8:21:52 PM,04-30-2006,107.8884,Top Barcode =
22 Chars,22,Broadcast Code,"fdvn",Char 1 - Label,8,Char 2 -
Label,9,Char 7 - Label,"6d",Char 8 - Label,1,Char 9 - Label,6,Char 10,
11, 12 - Label,117,Char 13 - Label,0,Char 14 - Label,0,Char 15 -
Label,0,Char 16 - Label,0,Top Barcode ??,P,Char 17 = Num ?,0,Char 18 =
Num ?,6,Char 19 = Num ?,0,Char 20 = Num ?,4,Char 21 = Num ?,2,Char 22 =
Num ?,7,ALC code ?,"ALC OK",Top Barcode = 22 Chars,22,Broadcast
Code,"fdvn",Char 1 - Label,8,Char 2 - Label,9,Char 7 - Label,"6d",Char
8 - Label,1,Char 9 - Label,6,Char 10, 11, 12 - Label,117,Char 13 -
Label,0,Char 14 - Label,0,Char 15 - Label,0,Char 16 - Label,0,Top
Barcode ??,P,Char 17 = Num ?,0,Char 18 = Num ?,6,Char 19 = Num ?,0,Char
20 = Num ?,4,Char 21 = Num ?,0,Char 22 = Num ?,2,ALC code ?,"ALC OK",0
0,89fdvnm161170304,...
