G
Guest
I am trying to use the code below to import a tab delimted file which is
downloaded from our purchasing system. The file I am trying to import has
over 6000 records. The code runs to record 4603 and then stops with the error
Subscript out of range on line:
RS1.Fields(25).Value = strArray(27) I have checked the record on the report
I am importing from and I cannot see anything different from norm. Does
anyone know why this might be happening or could you suggest a way to debug
this?
TIA
Sub cmdImportPODetails_Click()
Dim RS1 As DAO.Recordset
'Dim RS1 As Recordset
Dim FP1 As Integer
Dim strData As String, strArray() As String
SourceFile = InputBox("PO Details", "Source file", "F:\")
Set RS1 = CurrentDb.OpenRecordset("tblPODetails", dbOpenTable)
FP1 = FreeFile
Open SourceFile For Input As FP1
Do Until EOF(FP1)
Line Input #FP1, strData
strArray = Split(strData, vbTab)
If Not strData = "" Then 'exclude gaps in header
If Not (Mid(strData, 3, 1) = ".") Then 'exclude header lines
If Len(strArray(0)) = 0 Then 'exclude report title in line 1
If Not strArray(1) = "Purch.doc." Then 'exclude column heading
RS1.AddNew
RS1.Fields(0).Value = strArray(1)
RS1.Fields(1).Value = strArray(2)
RS1.Fields(2).Value = strArray(3)
RS1.Fields(3).Value = strArray(4)
RS1.Fields(4).Value = strArray(5)
RS1.Fields(5).Value = strArray(6)
RS1.Fields(6).Value = Left(strArray(7), 2) & "/" & _
Mid(strArray(7), 4, 2) & "/" & Right(strArray(7), 4)
RS1.Fields(7).Value = Left(strArray(8), 2) & "/" & _
Mid(strArray(8), 4, 2) & "/" & Right(strArray(8), 4)
RS1.Fields(8).Value = strArray(9)
RS1.Fields(9).Value = strArray(10)
RS1.Fields(10).Value = strArray(11)
RS1.Fields(11).Value = strArray(12)
RS1.Fields(12).Value = strArray(13)
RS1.Fields(13).Value = strArray(14)
RS1.Fields(14).Value = strArray(15)
RS1.Fields(15).Value = strArray(16)
RS1.Fields(16).Value = strArray(17)
RS1.Fields(17).Value = strArray(18)
RS1.Fields(18).Value = strArray(19)
RS1.Fields(19).Value = strArray(21)
RS1.Fields(20).Value = strArray(22)
If strArray(23) <> "" Then
RS1.Fields(21).Value = strArray(23)
End If
If strArray(24) <> "" Then
RS1.Fields(22).Value = strArray(24)
End If
If strArray(25) <> "" Then
RS1.Fields(23).Value = strArray(25)
End If
If strArray(26) <> "" Then
RS1.Fields(24).Value = strArray(26)
End If
If strArray(27) <> "" Then
RS1.Fields(25).Value = strArray(27)
End If
RS1.Update
End If
End If
End If
End If
Loop
Close FP1
RS1.Close
MsgBox ("Import complete")
End Sub
downloaded from our purchasing system. The file I am trying to import has
over 6000 records. The code runs to record 4603 and then stops with the error
Subscript out of range on line:
RS1.Fields(25).Value = strArray(27) I have checked the record on the report
I am importing from and I cannot see anything different from norm. Does
anyone know why this might be happening or could you suggest a way to debug
this?
TIA
Sub cmdImportPODetails_Click()
Dim RS1 As DAO.Recordset
'Dim RS1 As Recordset
Dim FP1 As Integer
Dim strData As String, strArray() As String
SourceFile = InputBox("PO Details", "Source file", "F:\")
Set RS1 = CurrentDb.OpenRecordset("tblPODetails", dbOpenTable)
FP1 = FreeFile
Open SourceFile For Input As FP1
Do Until EOF(FP1)
Line Input #FP1, strData
strArray = Split(strData, vbTab)
If Not strData = "" Then 'exclude gaps in header
If Not (Mid(strData, 3, 1) = ".") Then 'exclude header lines
If Len(strArray(0)) = 0 Then 'exclude report title in line 1
If Not strArray(1) = "Purch.doc." Then 'exclude column heading
RS1.AddNew
RS1.Fields(0).Value = strArray(1)
RS1.Fields(1).Value = strArray(2)
RS1.Fields(2).Value = strArray(3)
RS1.Fields(3).Value = strArray(4)
RS1.Fields(4).Value = strArray(5)
RS1.Fields(5).Value = strArray(6)
RS1.Fields(6).Value = Left(strArray(7), 2) & "/" & _
Mid(strArray(7), 4, 2) & "/" & Right(strArray(7), 4)
RS1.Fields(7).Value = Left(strArray(8), 2) & "/" & _
Mid(strArray(8), 4, 2) & "/" & Right(strArray(8), 4)
RS1.Fields(8).Value = strArray(9)
RS1.Fields(9).Value = strArray(10)
RS1.Fields(10).Value = strArray(11)
RS1.Fields(11).Value = strArray(12)
RS1.Fields(12).Value = strArray(13)
RS1.Fields(13).Value = strArray(14)
RS1.Fields(14).Value = strArray(15)
RS1.Fields(15).Value = strArray(16)
RS1.Fields(16).Value = strArray(17)
RS1.Fields(17).Value = strArray(18)
RS1.Fields(18).Value = strArray(19)
RS1.Fields(19).Value = strArray(21)
RS1.Fields(20).Value = strArray(22)
If strArray(23) <> "" Then
RS1.Fields(21).Value = strArray(23)
End If
If strArray(24) <> "" Then
RS1.Fields(22).Value = strArray(24)
End If
If strArray(25) <> "" Then
RS1.Fields(23).Value = strArray(25)
End If
If strArray(26) <> "" Then
RS1.Fields(24).Value = strArray(26)
End If
If strArray(27) <> "" Then
RS1.Fields(25).Value = strArray(27)
End If
RS1.Update
End If
End If
End If
End If
Loop
Close FP1
RS1.Close
MsgBox ("Import complete")
End Sub