Using Access '95, I have created a very simple database that has only 1 field. I am trying to import a text file into this database. One line of the text file equals one record in my database. I have written the code behind a form's button in VB6...and it works... sometimes. I may have to import the text file 2-4 times before it imports correctly. ** Note: everything remains the same, no changes have been made to the text file, database or coding... just the import routine is performed several times. The first thing I do is clear out the database... then the import is done. Here's the coding I'm using. Any help is greatly appreciated.
On Error GoTo ErrorHandler 'Enable error handling routine
FileLoc = "S:\Users\Mis\Vtd8\PackList\"
cmdImport.Enabled = False
cmdPrint.Enabled = False
Label3.Caption = " Clearing database Please wait..."
'Delete everything out of the database (FileLoc + "Packlst.mdb"
DataEnvironment1.Command1
Label3.Caption = " Accessing File Please wait..."
Set FSYS = CreateObject("Scripting.FileSystemObject"
Set F = FSYS.GetFile(FileLoc + "packlst.txt"
Set TStream = F.OpenAsTextStream(ForReading, TristateUseDefault)
' Count records in the file
RC = 1
Do While TStream.AtEndOfStream = False
TS = TStream.ReadLine
RC = RC + 1
Loop
RC = RC - 1
TC = RC
' Reset to the beginning of the file...
Set TStream = F.OpenAsTextStream(ForReading, TristateUseDefault)
RC = 1
' Read each record from the text file and write to the database "record" field
Do While TStream.AtEndOfStream = False
Label1.Caption = "Percent Complete: " + Str(Int((RC / TC) * 100)) + "%"
Label2.Caption = "Record Processed: " + Str(RC)
Label3.Caption = " Importing Data Please wait..."
frmCPAPack.Refresh
DoEvents
Adodc1.Recordset.AddNew
TS = TStream.ReadLine
'Search for the "{" from mainframe's signed field
'and replace with a zero.
Brce = Mid$(TS, 92, 1)
If Brce = "{" Then
part1 = Mid$(TS, 1, 91)
part2 = Mid$(TS, 93, 14)
TS = part1 + "0" + part2
Adodc1.Recordset.Fields("Record" = TS
Else
Adodc1.Recordset.Fields("Record" = TS
End If
Adodc1.Recordset.Update
RC = RC + 1
Loop
Adodc1.Recordset.Close
cmdPrint.Enabled = True
msg = "Import Successful! " + Str(TC) + " Records added."
MsgBox msg, , "Import Status"
cmdImport.Enabled = False
Label3.Caption = "Import Successful!"
Exit Sub
ErrorHandler:
MsgBox "The operation resulted in the following error " & vbCrLf & Err.Description
Cleardisplay = True
Thanks.
On Error GoTo ErrorHandler 'Enable error handling routine
FileLoc = "S:\Users\Mis\Vtd8\PackList\"
cmdImport.Enabled = False
cmdPrint.Enabled = False
Label3.Caption = " Clearing database Please wait..."
'Delete everything out of the database (FileLoc + "Packlst.mdb"
DataEnvironment1.Command1
Label3.Caption = " Accessing File Please wait..."
Set FSYS = CreateObject("Scripting.FileSystemObject"
Set F = FSYS.GetFile(FileLoc + "packlst.txt"
Set TStream = F.OpenAsTextStream(ForReading, TristateUseDefault)
' Count records in the file
RC = 1
Do While TStream.AtEndOfStream = False
TS = TStream.ReadLine
RC = RC + 1
Loop
RC = RC - 1
TC = RC
' Reset to the beginning of the file...
Set TStream = F.OpenAsTextStream(ForReading, TristateUseDefault)
RC = 1
' Read each record from the text file and write to the database "record" field
Do While TStream.AtEndOfStream = False
Label1.Caption = "Percent Complete: " + Str(Int((RC / TC) * 100)) + "%"
Label2.Caption = "Record Processed: " + Str(RC)
Label3.Caption = " Importing Data Please wait..."
frmCPAPack.Refresh
DoEvents
Adodc1.Recordset.AddNew
TS = TStream.ReadLine
'Search for the "{" from mainframe's signed field
'and replace with a zero.
Brce = Mid$(TS, 92, 1)
If Brce = "{" Then
part1 = Mid$(TS, 1, 91)
part2 = Mid$(TS, 93, 14)
TS = part1 + "0" + part2
Adodc1.Recordset.Fields("Record" = TS
Else
Adodc1.Recordset.Fields("Record" = TS
End If
Adodc1.Recordset.Update
RC = RC + 1
Loop
Adodc1.Recordset.Close
cmdPrint.Enabled = True
msg = "Import Successful! " + Str(TC) + " Records added."
MsgBox msg, , "Import Status"
cmdImport.Enabled = False
Label3.Caption = "Import Successful!"
Exit Sub
ErrorHandler:
MsgBox "The operation resulted in the following error " & vbCrLf & Err.Description
Cleardisplay = True
Thanks.