lucpian
04-09-2008, 08:25 AM
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:
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
Please, what am I still doing wrong?
Thanks
Lucpian
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:
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
Please, what am I still doing wrong?
Thanks
Lucpian