Sorry forgot to attach the code portion
Private Sub BUTSAVE_Click()
On Error GoTo errSect
Dim stAction As String
Dim lnerr As Double
stAction = "Main.ButSave"
lnerr = 1
Dim stMsg As String
Dim insub As Integer
Dim stdb As String
Dim inOpen As Integer
MsgMe "Saving Temporary"
lnerr = 2
If Label > "" Then
Else
lnerr = 2.2
Label = "Regular"
End If
lnerr = 3
If MainId > "" Then
Else
lnerr = 3.2
MainId = Trim(ItemNo) & "." & Trim(FormulaNo) & "." & Trim(Label)
End If
lnerr = 4
RecUser = GetUserId()
lnerr = 4.5
RecDt = Now()
lnerr = 5
DoCmd.SelectObject acForm, "Main Form"
lnerr = 5.1
'DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.RunCommand acCmdSaveRecord
lnerr = 5.2
If Not IsLoaded("frmMessage") Then DoCmd.OpenForm "frmMessage"
lnerr = 5.3
DoCmd.SelectObject acForm, "frmMessage"
MsgMe "Saving Permanent"
DoCmd.SetWarnings False
lnerr = 6
inOpen = ObjFind("MAINT297") 'LINKED MAIN
lnerr = 7
MsgMe "Loading Permanent"
' If insub = 1 Then
' Else
' MsgMe "Linking Permanent"
' lnerr = 7.2
' stdb = "f:\platinum\iis\maint297.mdb"
' lnerr = 7.21
' DoCmd.TransferDatabase acLink, "Microsoft Access", stdb, acTable, "Main", "Maint297"
' End If
' lnerr = 8
' MsgMe "Updating Permanent"
' DoCmd.OpenQuery "qryUpdateMainRD", acViewNormal
PutMaint297 MainId
MsgMe "Unloading Permanent"
lnerr = 9
If inOpen = 0 And ObjFind("MAINT297") = 1 Then DoCmd.DeleteObject acTable, "Maint297"
DoCmd.SetWarnings True
exitSect:
MsgMe ""
Exit Sub
errSect:
stMsg = "ItemNo=" & Trim(ItemNo) & " FormNo=" & Trim(FormulaNo)
stMsg = stMsg & " Label=" & Trim(Label) & "/" & lnerr
MsgBox Err.Description, , "ERROR: Duplicate " & stMsg
Resume exitSect
End Sub