Failed to archive records

[Jaafar]

in a application used heavly by 6 users, i have 3 linked
tables from a server database. Every time,the user hit
Submit Transaction, a process append the data from local
tables into the server tables for the transaction in
question. the code check for existing transaction before,
and delete it if it exists.
My question is: very often some of the transactions don't
get archived. most of the time i have to repair and
compact the server database that has the 3 server tables.

Note: more than one user could be submitting at the same
time.
This is the code that i am using.


Public Function ArchiveTransaction(TransNo As String) As
Boolean
Dim strCri As String

On Error GoTo ErrHandl

strCri = "TransNo = '" & TransNo & "'"

'Delete the transaction it is already in archive
ClearTable "Transhdr", strCri

'Delete the transaction it is already in archive
ClearTable "Permithdr", strCri

'Delete the transaction it is already in archive
ClearTable "Permitlns", strCri


'Archive Transaction Header
AppendToTable "TransBuff", "Transhdr", strCri

'Archive Apllication header
AppendToTable "PermithdrBuff", "Permithdr", strCri

'Archive Application Lines
AppendToTable "PermitlnsBuff", "Permitlns", strCri



ArchiveTransaction = True
ErrHandl_Exit:
Exit Function

ErrHandl:
MsgBox Err.Description
Call ErrorLog(TransNo, Err.Description)
ArchiveTransaction = False
Resume ErrHandl_Exit:
End Function



' This function delete some or all records from the table
depending on the criteria

Public Sub ClearTable(TblName As String, Optional strCri
As Variant)

Dim dbs As Database
Dim strSQL As String

Set dbs = CurrentDb

strSQL = " Delete " & TblName _
& ".* From " & TblName

If (Not IsMissing(strCri)) Then
strSQL = strSQL & " WHERE " & TblName & "." &
strCri
End If
Debug.Print strSQL
dbs.Execute strSQL
dbs.Close
Set dbs = Nothing
End Sub



'Append to destination table that has the same source date
structure

Public Sub AppendToTable(SourceTbl, DestTbl As String,
Optional strCri As Variant)
Dim dbs As Database
Dim strSQL As String

Set dbs = CurrentDb

strSQL = " INSERT INTO " & DestTbl _
& " SELECT " & SourceTbl & ".* FROM " &
SourceTbl
If (Not IsMissing(strCri)) Then
strSQL = strSQL & " WHERE " & SourceTbl & "." &
strCri
End If
Debug.Print strSQL
dbs.Execute strSQL
dbs.Close
Set dbs = Nothing
End Sub

Can someone help?
Thanks

 

[[MVP] S. Clark]

With mulitiple users doing the same thing, what precautions are you taking
in the form of table locking? Does ClearTable do anything to ensure that no
other user is already doing it?

--
HTH,

Steve Clark, Access MVP
FMS, Inc.
Professional Solutions Group
http://www.FMSInc.com
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Is your Access database too slow?
Are you ready to upgrade to SQL Server?
Contact us for optimization and/or upsizing!
http://www.FMSInc.com/consulting
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-