Import Delimited File Using Split Function

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Twice a week I receive a Delimited file with 350,000 records and 200 fields
in each record. I want to import all of the records, but only some of the
fields. I want to do this via the vba Split Function, without a
Specification file (ie; with using TransferText). Problem is, I'm getting
each record multiple times. I'm sure it's because of my "For" statement.
But without it, I get RunTime Error 9 (Subscript out of range).
Following is the sample Delimited file and code:

Delimited File (JEG06.txt)
A1,A2,A3,A4,A5
B1,B2,B3,B4,B5
C1,C2,C3,C4,C5

==========================================================

Private Sub cmdDelimited_Click()
DoCmd.Hourglass True
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("Delimited")
Do Until Rst.EOF
With Rst
.MoveFirst
.Delete
.MoveNext
End With
Loop
Rst.Close
Set Rst = Nothing

Dim rs1 As DAO.Recordset
Dim FileName As String
Dim FileDate As Date
Dim FileNum As Integer
Dim strFilter As String
Dim strFileDesc As String
Dim strFileExt As String
Dim strRecord As String
Dim strRecordArray() As String
Dim intCount As Integer
Dim InputString

strFilter = ahtAddFilterItem(strFilter, strFileDesc, strFileExt)
strFileDesc = "Text Files (*.txt)"
strFileExt = "JEG06*.txt"

DoCmd.Hourglass False
FileName = ahtCommonFileOpenSave( _
Filter:=strFilter, _
InitialDir:="Y:\HR", _
OpenFile:=True, _
DialogTitle:="Select File for Import... JEG06.txt", _
Flags:=ahtOFN_HIDEREADONLY)
FileDate = FileDateTime(FileName)
FileNum = FreeFile()

Set rs1 = CurrentDb.OpenRecordset("Delimited")
DoCmd.Hourglass True
Open FileName For Input As #FileNum
Do While Not (EOF(FileNum))
Line Input #FileNum, InputString
strRecordArray = Split(InputString, ",", 5)

For intCount = LBound(strRecordArray) To UBound(strRecordArray)
rs1.AddNew
rs1.Fields("PersID") = strRecordArray(0)
rs1.Fields("NameL") = strRecordArray(1)
rs1.Fields("NameF") = strRecordArray(2)
rs1.Fields("MI") = strRecordArray(3)
rs1.Fields("SSN") = strRecordArray(4)
rs1.Update
' Exit For
Next
Loop
rs1.Close
Close #FileNum
DoCmd.Hourglass False

MsgBox "File Import Complete", vbInformation, "Import Status"

End Sub
=============================================

Any help will be greatly appreciated.
 
jhrBanker said:
Twice a week I receive a Delimited file with 350,000 records and 200
fields
in each record. I want to import all of the records, but only some of the
fields. I want to do this via the vba Split Function, without a
Specification file (ie; with using TransferText). Problem is, I'm getting
each record multiple times. I'm sure it's because of my "For" statement.
But without it, I get RunTime Error 9 (Subscript out of range).
Following is the sample Delimited file and code:

Delimited File (JEG06.txt)
A1,A2,A3,A4,A5
B1,B2,B3,B4,B5
C1,C2,C3,C4,C5

==========================================================

Private Sub cmdDelimited_Click()
DoCmd.Hourglass True
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("Delimited")
Do Until Rst.EOF
With Rst
.MoveFirst
.Delete
.MoveNext
End With
Loop
Rst.Close
Set Rst = Nothing

Dim rs1 As DAO.Recordset
Dim FileName As String
Dim FileDate As Date
Dim FileNum As Integer
Dim strFilter As String
Dim strFileDesc As String
Dim strFileExt As String
Dim strRecord As String
Dim strRecordArray() As String
Dim intCount As Integer
Dim InputString

strFilter = ahtAddFilterItem(strFilter, strFileDesc, strFileExt)
strFileDesc = "Text Files (*.txt)"
strFileExt = "JEG06*.txt"

DoCmd.Hourglass False
FileName = ahtCommonFileOpenSave( _
Filter:=strFilter, _
InitialDir:="Y:\HR", _
OpenFile:=True, _
DialogTitle:="Select File for Import... JEG06.txt", _
Flags:=ahtOFN_HIDEREADONLY)
FileDate = FileDateTime(FileName)
FileNum = FreeFile()

Set rs1 = CurrentDb.OpenRecordset("Delimited")
DoCmd.Hourglass True
Open FileName For Input As #FileNum
Do While Not (EOF(FileNum))
Line Input #FileNum, InputString
strRecordArray = Split(InputString, ",", 5)

For intCount = LBound(strRecordArray) To UBound(strRecordArray)
rs1.AddNew
rs1.Fields("PersID") = strRecordArray(0)
rs1.Fields("NameL") = strRecordArray(1)
rs1.Fields("NameF") = strRecordArray(2)
rs1.Fields("MI") = strRecordArray(3)
rs1.Fields("SSN") = strRecordArray(4)
rs1.Update
' Exit For
Next
Loop
rs1.Close
Close #FileNum
DoCmd.Hourglass False

MsgBox "File Import Complete", vbInformation, "Import Status"

End Sub
=============================================

Any help will be greatly appreciated.
Click to expand...



As you have seen - it's the For...Next that's doing it. You are adding a
record for each field in the line. If you are getting other errors then
perhaps you should check what the LBound and UBound are, before you proceed.
It looks like you expect 0 and 4 but you are not ending up with this.
 
The error 9 is caused by strRecordArray having a Ubound different that what
you expect. The Split function is not working according to the
documentation. The third argument, according to the documentation is a
compare type. Now, the interesting part I found in testing is that this
seems the documentation is incorrect. The third argument seems to actually
limit the maximum number of elements returned. In your code, the maximum
number of elements in the array will be 5 regardless of how many times it
finds the delimiter in the string. If there are fewer than 5, then the
Ubound will be the actual number of elements. I notice your code only
referres to 5 elements. The only thing I can guess is that in some cases,
there are fewer than 5 elements in the array.

As to why you are getting multiple records. It is because of the For loop.
if there are 5 elements in the array,then you will get 5 records. You are
creating records bases on the Ubound of the array. That is not what you
want. Take the For loop out, and you will add only 1 record. I would also
suggest you take the third argument out of the Split function, and test for
Ubound before you add records. My suggestion:

strRecordArray = Split(InputString, ",",)
If Ubound(strRecordArray) < 4 Then
MsgBox "Skipping Incomplete Record"
Else
rs1.AddNew
rs1.Fields("PersID") = strRecordArray(0)
rs1.Fields("NameL") = strRecordArray(1)
rs1.Fields("NameF") = strRecordArray(2)
rs1.Fields("MI") = strRecordArray(3)
rs1.Fields("SSN") = strRecordArray(4)
rs1.Update
End If

One other thing, If the intent of your first bit of code is to delete all
the records in Delimited, here is an easier and faster way:

CurrentDb.Execute "DELETE * FROM Delimited;"
 
Wouldn't it be a lot simpler to use a query to extract the fields you need
from the text file?
The syntax is like this, assuming the field doesn't contain a header row
with field names:

SELECT F1, F3, F99
FROM [Text;HDR=No;Database=C:\Folder\;].Filename#txt;

(this returns fields 1, 3, and 99 from C:\Folder\Filename.txt). An append
query would be like this:

INSERT INTO MyTable ( FieldOne, NextField, AnotherField )
SELECT F1, F3, F99
FROM [Text;HDR=No;Database=C:\Folder\;].Filename#txt;
 
EXCELLENT!
There was a carriage return after the "last" record, so the actual last
record had no fields.
Code works fine now.
ALSO, thanks for the tip on deleting the records. That will definitely
speedup the process.
Muchly appreciated.
 
Back
Top