Match headers when importing text files

[lucpian]

Hi All,

I do have a code I have written to import text files, but will have to loop through to ensure that the headings match and is in the same order. It should give a message if out of sync, but should still import. It works, but does not import the data with the headings. Here is the code:

[VBA]
Sub ImportText2File()

Dim sFile As String
Dim lFNum As Long
Dim vaFields As Variant
Dim i As Long
Dim lRow As Long
Dim vaStrip As Variant
Dim FileName As Variant
Dim Sep As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:
lFNum = FreeFile

sFile = Application.GetOpenFilename(FileFilter:="Excel File (*.txt),*.txt")
'If sFile = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
' Exit Sub
'End If
Const sDELIM = "," 'Set the delimiter

lFNum = FreeFile

vaStrip = Array(vbLf, vbTab) 'list the text to strip

'Open the file
Open sFile For Input As lFNum

vaFields = GetData(lFNum, vaStrip, sDELIM)
i = LBound(vaFields)
If UBound(vaFields) - i + 1 = 18 Then

If vaFields(i) = "Contract" And _
vaFields(i + 1) = "Effective Date" And _
vaFields(i + 2) = "Install Date" And _
vaFields(i + 3) = "On Maint Date" And _
vaFields(i + 4) = "Serial Number" And _
vaFields(i + 5) = "Cost" And _
vaFields(i + 6) = "Catalog ID" And _
vaFields(i + 7) = "Room Can" And _
vaFields(i + 8) = "Class" And _
vaFields(i + 9) = "Speed" And _
vaFields(i + 10) = "Office Code" And _
vaFields(i + 11) = "Contact Name" And _
vaFields(i + 12) = "Contact Phone" And _
vaFields(i + 13) = "Bar Code" And _
vaFields(i + 14) = "Monitor Size" And _
vaFields(i + 15) = "Call No" And _
vaFields(i + 16) = "Maint Freq" And _
vaFields(i + 17) = "Owner Can" Then


lRow = 1
Do While Not EOF(lFNum)
If lRow > 1 Then vaFields = GetData(lFNum, vaStrip, sDELIM)
'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
lRow = lRow + 1
Loop


Else

MsgBox "The fields are not arrange in order. Invalid headers"
End If
'MsgBox ((i))
Else
Response = MsgBox("The fields are not arrange in order. Do you still want it to import?", vbYesNo)
'lRow = 1
If Response = vbYes And lRow > 1 Then vaFields = GetData(lFNum, vaStrip, sDELIM)
'Open sFile For Input As lFNum

vaFields = GetData(lFNum, vaStrip, sDELIM)
i = LBound(vaFields)


'Loop through the file until the end
Do While Not EOF(lFNum)

vaFields = GetData(lFNum, vaStrip, sDELIM)
lRow = lRow + 1

'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
'lRow = lRow + 1
Loop



If Response = vbNo Then

MsgBox "The fields are not arrange in order. Invalid headers"
End If
'End If

End If

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close lFNum

End Sub

Private Function GetData(ByVal FileNum As Long, _
ByVal Redundant As Variant, _
ByVal Delimiter As String) As Variant
Dim sInput As String
Dim i As Long

Line Input #FileNum, sInput 'input the current line
'remove the unwanted text
For i = LBound(Redundant) To UBound(Redundant)
sInput = Replace(sInput, Redundant(i), " ")
Next i

'split the text based on the delimeter
GetData = Split(sInput, Delimiter)
End Function
[/VBA]
Please, what am I still doing wrong?

Thanks

Lucpian

[mdmackillop]

Lucpian,
You have been asked before to format your code. If you choose not to do this, you will be suspended.

[lucpian]

Thanks, will take note.

[figment]

if your checking to see that the headings exist, then why not just hardcode them into the macro, rathe rthen trying to input them from the text file?