Preventing the same text file from being imported twice

[Guest_imported]

Hello, I hope someone can help me with this. Let me start off by saying that I'm am somewhat new to VB but I'm a quick learner. Much of the code that I'm using in pre-existing code. I've had to modify it to fit my needs. I'm using an import utility import customer information. My question is this: "How do I prevent a person from importing the same text file twice?" I've included the code so that everyone can see what's going on. The utility is designed to create an Access Database with a table. The import portion is setup to append to the created table. Can anyone give me a hand?

CODE:
Private Sub cmdExport_Click()
Dim DB1 As Database
Dim RS1 As Recordset
Dim sOutput As String
Dim FP1 As Integer
Dim I As Integer
Dim J As Integer
Dim FileType As Integer
'Check to see if user entered file name for output file.
If txtOutput.Text = "" Then
MsgBox "Please enter a file name for the export file in the Output Text File Name text box at the top of the form."
Exit Sub
End If
'Check to see what type of file to export.
For I = 0 To optFileType.Count - 1 'Loop through Filetype options.
If optFileType(I).Value = True Then 'check to see if given option is true.
FileType = I ' OK this option was selected, save the value.
Exit For 'We got what we're looking for now get out.
End If
Next
'If Len(Dir(I:\Rtlbx\Anthony\AnthonyDB.mdb&quot) = 0 Then
cmdImport_Click 'Make the DB to be sure we have good data to export.
'End If
Set DB1 = OpenDatabase("I:\Rtlbx\Anthony\AnthonyDB.mdb", False, False)
Set RS1 = DB1.OpenRecordset("Wausau Import&quot
RS1.MoveLast 'Must do this to get accurate count of records with large recordsets.
RS1.MoveFirst 'Go back.
If InStr(1, txtOutput.Text, ":\&quot = 0 Then
txtOutput.Text = "I:\Rtlbx\Anthony" & "\" & txtOutput.Text 'Put a path on the filename if it doesn't have one already.
End If
FP1 = FreeFile 'Get a file number so we can reference a file.
Open txtOutput.Text For Output As #FP1
For I = 1 To RS1.RecordCount
With MyRec
.Date = RS1.Fields(1)
.CustomerNumber = RS1.Fields(2)
.Groups = RS1.Fields(3)
.GoodChecks = RS1.Fields(4)
.Rejs1 = RS1.Fields(5)
.CheckCount = RS1.Fields(6)
.CheckTotal = RS1.Fields(7)
.GoodStubs = RS1.Fields(8)
.StubTotal = RS1.Fields(9)
.Rejs2 = RS1.Fields(10)
.Fullpay1 = RS1.Fields(11)
.Fullpay2 = RS1.Fields(12)
.Partials1 = RS1.Fields(13)
.Partials2 = RS1.Fields(14)
Select Case FileType
Case 0 'this one writes the file with double quotes and commas as delimiters.
Write #FP1, "" & .Date & "", "" & .CustomerNumber & "", "" & .Groups & "", "" & .GoodChecks & "", "" & .Rejs1 & "", "" & .CheckCount & "", "" & .CheckTotal & "", "" & .GoodStubs & "", "" & .StubTotal & "", "" & .Rejs1 & "", "" & .Fullpay1; "", "" & .Fullpay2 & "", "" & .Partials1 & "", "" & .Partials2 & ""
Case 1 'this one writes the file with commas as delimiters.
Print #FP1, .Date & "," & .CustomerNumber & "," & .Groups & "," & .GoodChecks & "," & .Rejs1 & "," & .CheckCount & "," & .CheckTotal; "," & .GoodStubs; "," & .StubTotal; "," & .Rejs1; "," & .Fullpay1; "," & .Fullpay2; "," & .Partials1; "," & .Partials2
Case 2 'This one writes the files with double quotes as delimiters.
Write #FP1, "" & .Date & """" & .CustomerNumber & """" & .Groups & """" & .GoodChecks & """" & .Rejs1 & """" & .CheckCount & """" & .CheckTotal & """" & .GoodStubs & """" & .StubTotal & """" & .Rejs1 & """" & .Fullpay1 & """" & .Fullpay2 & """" & .Partials1 & """" & .Partials2 & ""
End Select
End With
sOutput = ""
RS1.MoveNext
Next
Close
Set RS1 = Nothing
Set DB1 = Nothing
MsgBox "Done creating output file."
End Sub


Private Sub cmdImport_Click()
Dim DB1 As Database
Dim RS1 As Recordset
Dim FP1 As Integer
Dim DBName As String
Dim I As Integer
On Local Error GoTo ErrHandler
txtResults.Text = ""
'cmdMakeDB_Click 'Create a new database
DBName = "I:\Rtlbx\Anthony\Anthonydb.mdb"
FP1 = FreeFile
Open txtFileName.Text For Input As FP1
Set DB1 = OpenDatabase(DBName, False, False)
Set RS1 = DB1.OpenRecordset("Wausau Import&quot 'this opens the whole table
Do Until EOF(FP1)
With MyRec
Input #FP1, .Date, .CustomerNumber, .Groups, .GoodChecks, .Rejs1, .CheckCount, .CheckTotal, .GoodStubs, .StubTotal, .Rejs2, .Fullpay1, .Fullpay2, .Partials1, .Partials2
RS1.AddNew 'Add a new record into the DB.
RS1.Fields(1).Value = .Date
RS1.Fields(2).Value = .CustomerNumber
RS1.Fields(3).Value = .Groups
RS1.Fields(4).Value = .GoodChecks
RS1.Fields(5).Value = .Rejs1
RS1.Fields(6).Value = .CheckCount
RS1.Fields(7).Value = .CheckTotal
RS1.Fields(8).Value = .GoodStubs
RS1.Fields(9).Value = .StubTotal
RS1.Fields(10).Value = .Rejs2
RS1.Fields(11).Value = .Fullpay1
RS1.Fields(12).Value = .Fullpay2
RS1.Fields(13).Value = .Partials1
RS1.Fields(14).Value = .Partials2
RS1.Update 'Write the record to the DB.
End With
Loop
RS1.MoveLast 'this makes sure we have to whole recordset.
'Not really necessary here but in large recordsets it is
' necessary to make sure the DB Engine gets the entire recordset.
RS1.MoveFirst
For I = 1 To RS1.RecordCount
With RS1 'So we don't need to type RS every time.
'the following line will put the record, with its Reference number in the text box.
txtResults.Text = txtResults.Text & .Fields(0) & " " & .Fields(1) & " " & .Fields(2) & " " & .Fields(3) & " " & .Fields(4) & " " & .Fields(5) & " " & .Fields(6) & " " & .Fields(7) & " " & .Fields(8) & " " & .Fields(9) & " " & .Fields(10) & " " & .Fields(11) & " " & .Fields(12) & " " & .Fields(13) & " " & .Fields(14) & vbCrLf
.MoveNext
End With
Next
Close 'Close all files. This could have been referenced using #FP1 to close a particular file also.
Set DB1 = Nothing 'Free up the resources used by this object.
MsgBox "File has been successfully imported"
Exit Sub
ErrHandler:
If Err.Number = 62 Then ' Just go on to the next instrcution be cause we have to populate the text box yet.
MsgBox "the end of the file was reached an it had a linefeed and/or a carriage return(s) at the end."
Resume Next
Else 'something we didn't account for. We'll see it now and account for it next time.
MsgBox "There was an error in the Read And Import Into Database procedure. Here is the error data:" & vbCrLf & Err.Number & ": " & Err.Description
End If
End Sub
Private Sub cmdMakeDB_Click()
Dim DBE1 As DBEngine
Dim WS1 As Workspace
Dim NewDB As Database
Dim TD1 As TableDef
Dim Field1 As Field
Dim db As Connection
Dim IDX1 As Index
Dim DBName As String
On Local Error GoTo ErrHandler
DBName = "I:\Rtlbx\Anthony\AnthonyDB.mdb"
If Len(Dir$(DBName, 16)) Then
Kill DBName
End If
Set WS1 = DBEngine.Workspaces(0) 'this isn't necessary in many cases
' But if it is used the next line would be Set NewDB = WS1.CreateDatabase(...
Set NewDB = CreateDatabase(DBName, dbLangGeneral, dbVersion20)
Set TD1 = NewDB.CreateTableDef("Wausau Import&quot
Set IDX1 = TD1.CreateIndex("RefIDX&quot
IDX1.Primary = False 'Set primary key
IDX1.Fields.Append IDX1.CreateField("RefID&quot 'Trust me, this works, weird as it is.
TD1.Indexes.Append IDX1
Set Field1 = TD1.CreateField("RefID", dbLong)
Field1.Attributes = dbAutoIncrField ' make it a counter.
'There's a bunch of Attributes we can set for the fields before we append
' them but I'm not going to go into it here.
TD1.Fields.Append Field1 ' Add it to the tabeldef.
Set Field1 = TD1.CreateField("Date", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("CustomerNumber", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Groups", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("GoodChecks", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Rejs1", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("CheckCount", dbText, 40) 'make it this size and of type dbText because of the Zip extensions that have hyphen in them.
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("CheckTotal", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("GoodStubs", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("StubTotal", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Rejs2", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Fullpay1", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Fullpay2", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Partials1", dbText, 40)
TD1.Fields.Append Field1
Set Field1 = TD1.CreateField("Partials2", dbText, 40)
TD1.Fields.Append Field1
NewDB.TableDefs.Append TD1 'the table is actually created in the DB here.
'now we've just created a database, a table,
' fields in the table, an autonumber field,
' and put an index on the table.
'Free up memory we're using.
Set NewDB = Nothing ' If we were using Public or
' Global scopes we could just create a recordset
' directly from this object and use it immediately
' after creating it, ie. RS1=NewDB.OpenReordSet("Wausau Import&quot
Set TD1 = Nothing
Set Field1 = Nothing
Set IDX1 = Nothing
Exit Sub
ErrHandler:
MsgBox "There was an error in the Make Database procedure. Here is the error data:" & vbCrLf & Err.Number & ": " & Err.Description
Exit Sub
End Sub
Private Sub cmdReadDisplay_Click()
Dim FP1 As Integer
Dim LB As String
Dim sDate As String
Dim sCustomerNumber As String
Dim sGoodChecks As String
Dim sRejs1 As String
Dim sCheckCount As String
Dim sCheckTotal As String
Dim sGoodStubs As String
Dim sStubTotal As String
Dim sRejs2 As String
Dim sFullpay1 As String
Dim sFullpay2 As String
Dim sPartials1 As String
Dim sPartials2 As String
txtResults.Text = ""
FP1 = FreeFile
On Local Error GoTo ER1
Open txtFileName.Text For Input As FP1
Do Until EOF(FP1) ' Still use "EOF" because it's simple. We'll catch any errors.
With MyRec 'Makes faster code
Input #FP1, .Date, .Groups, .CustomerNumber, .GoodChecks, .Rejs1, .CheckCount, .CheckTotal, .GoodStubs, .StubTotal, .Rejs2, .Fullpay1, .Fullpay2, .Partials1, .Partials2
txtResults.Text = txtResults.Text & .Date & " " & .Groups & " " & .CustomerNumber & " " & .GoodChecks & " " & .Rejs1 & " " & .CheckCount & " " & .CheckTotal & " " & .GoodStubs & " " & .StubTotal & " " & .Rejs2 & " " & .Fullpay1 & " " & .Fullpay2 & " " & .Partials1 & " " & .Partials2 & vbCrLf
End With
Loop
Close #FP1 'Close file
Exit Sub
ER1:
If Err.Number = 62 Then
MsgBox "End of file " & txtFileName.Text & " has been reached and there was a linefeed and/or cariage return at the end!"
Exit Sub
End If
End Sub

 

[CybOrg]

Hmm - I didn't really look into all that code, but there are a number of ways you can go about it:
1) You define a unique index on the table. This only works if there IS uniqueness, of course.

2) When you open the file, use the FileDateTime function to obtain the file timestamp, then insert a record into another table, indicating that the file with name so-and-so and version so-and-so was read into the database by user currentuser() on now() - if you get my drift... ;-) If you define the new table with a counter-type ID field, you can modify the design of your current table, adding a long integer field (calling it perhaps 'ImportedFileID'), and adding that piece of data to the imported stuff. That way you can alwys go back and remove duplicate files.

3) Add a step to the import routine, to delete or at least move the input file to a safe place, to prevent the same physical file from being imported twice, at least.