Import Error

[Guest]

Hi

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?

Also I am using some if statements at the end of the recordset as the field
could be null or a zero length string and this seems to cause my code to
crash. Is this the right way of trapping this error or am i doing something
wrong?

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

 

[John Spencer (MVP)]

Well, you are assuming that each record is being split into at least 28 array cells.

That may not be the case and you don't test for that in your code. I would use
the ubound function to see how many "cells" are returned to the array. If you
are trying to do that with this line
If strArray(23) <> "" Then
Then you will get a failure since strArray(23) does not even exist (and
therefore you get the subscript out of range error.

I would do something like
Dim lngArraySize as Long

If Not strArray(1) = "Purch.doc." Then
lngArraySize = UBound(strArray)
...
If lngArraySize > 23 then
RS1.Fields(21) = strArray(23)
End If

You could probably rewrite the last section to do a loop to automatically take
care of the changes in the number "cells" in the array.

For iCount = 23 to UBound(StrArray)
RS1.Fields(ICount-2) = StrArray(iCount)
Next ICount