When I open the database it keeps repairing itself.
I also received this message when I try to close the ms access.
I am the only user.
When I open the database.
Please help here is my code.
frmAdd
Code:
Option Compare Database
Option Explicit
Private Sub btnAdd_Exit(Cancel As Integer)
Forms("frmMain").Requery
End Sub
Private Sub btnClose_Click()
On Error GoTo Err_Catch
Me.Undo
DoCmd.Close
btnClose_Click:
Exit Sub
Err_Catch:
MsgBox Err.Description
Resume btnClose_Click
End Sub
Private Sub CatergoryInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("CatergoryInfo", dbOpenDynaset)
If vbYes = MsgBox("Category is not in the list. Do you wish to add " _
& NewData & " as a new Category?", _
vbYesNo + vbInformation, _
"New Category") Then
rst.AddNew
rst!Category = NewData
rst.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
leave:
If Not rst Is Nothing Then
rst.Close: Set rst = Nothing
End If
Exit Sub
myError:
MsgBox "Error " & Err.Number & ": " & Error$
Resume leave
End Sub
Private Sub CompanyInfo_ID_Change()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub
Private Sub CompanyInfo_ID_LostFocus()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub
Private Sub CountryInfo_ID_Change()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub
Private Sub CountryInfo_ID_LostFocus()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub
Private Sub CompanyInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("CompanyInfo", dbOpenDynaset)
If vbYes = MsgBox("Company name is not in the list. Do you wish to add " _
& NewData & " as a new Company?", _
vbYesNo + vbInformation, _
"New Company") Then
rst.AddNew
rst!CompanyName = NewData
rst.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
leave:
If Not rst Is Nothing Then
rst.Close: Set rst = Nothing
End If
Exit Sub
myError:
MsgBox "Error " & Err.Number & ": " & Error$
Resume leave
End Sub
Private Sub Email_AfterUpdate()
If IsNull(Me.Email.Value) Then
Me.cmbEmailStatus.Value = Null
Else
Me.cmbEmailStatus.Value = "NEW"
End If
End Sub
Private Sub Fax_BeforeUpdate(Cancel As Integer)
Dim rslt As Integer
If Nz(DLookup("[Fax]", "ContactDetails", "[Fax]='" & Me.Fax & "'"), 0) <> 0 Then
rslt = MsgBox("This number has already been entered. Do you wish to continue?", vbYesNo)
If rslt = vbNo Then
Cancel = True
'Me.Fax = Null
'Me.Fax.SetFocus
End If
End If
End Sub
Private Sub Form_Load()
DoCmd.GoToRecord , , acNewRec
End Sub
Private Sub Mobile_BeforeUpdate(Cancel As Integer)
Dim rslt As Integer
If Nz(DLookup("[Mobile]", "ContactDetails", "[Mobile]='" & Me.Mobile & "'"), 0) <> 0 Then
rslt = MsgBox("This number has already been entered. Do you wish to continue?", vbYesNo)
If rslt = vbNo Then
Cancel = True
'Me.Mobile = Null
'Me.Mobile.SetFocus
End If
End If
End Sub
Private Sub PositionInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("PositionInfo", dbOpenDynaset)
If vbYes = MsgBox("Position is not in the list. Do you wish to add " _
& NewData & " as a new Position?", _
vbYesNo + vbInformation, _
"New Position") Then
rst.AddNew
rst!Position = NewData
rst.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
leave:
If Not rst Is Nothing Then
rst.Close: Set rst = Nothing
End If
Exit Sub
myError:
MsgBox "Error " & Err.Number & ": " & Error$
Resume leave
End Sub
Private Sub Telephone_BeforeUpdate(Cancel As Integer)
Dim rslt As Integer
If Nz(DLookup("[Telephone]", "ContactDetails", "[Telephone]='" & Me.Telephone & "'"), 0) <> 0 Then
rslt = MsgBox("This number has already been entered. Do you wish to continue?", vbYesNo)
If rslt = vbNo Then
Cancel = True
'Me.Telephone = Null
'Me.Telephone.SetFocus
End If
End If
End Sub
frmMain
Code:
Option Compare Database
Option Explicit
Private Sub btnFind_Click()
DoCmd.RunCommand acCmdFind
End Sub
Private Sub btnReset_Click()
Me.FilterOn = False
End Sub
Private Sub Form_Load()
'fMakeBackup
Application.SetOption "Default Find/Replace Behavior", 1
Me.FilterOn = False
End Sub
frmSearch
Code:
Option Compare Database
Private Sub btnClear_Click()
For Each ctl In Me.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acCheckBox ' adjust to taste
'Debug.Print ctl.Name, Len(ctl.ControlSource)
If Len(ctl.ControlSource) = 0 Then
ctl.Value = Null
End If
Case Else
' pass
End Select
Next
Forms("frmMain").FilterOn = False
End Sub
Private Sub btnClose_Click()
On Error GoTo Err_Catch
DoCmd.Close
btnClose_Click:
Exit Sub
Err_Catch:
MsgBox Err.Description
Resume btnClose_Click
End Sub
Private Sub btnSearch_Click()
If Not CurrentProject.AllForms("frmMain").IsLoaded Then
DoCmd.OpenForm ("frmMain")
End If
'/////// PRIORITIES
If Not IsNull(Me.cmbPriorities) Then
Forms("frmMain").Filter = "[Priorities] Like " & Chr(34) & "*" & Me.cmbPriorities & "*" & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// FOLLOWUP
If Not IsNull(Me.Followup) Then
Forms("frmMain").Filter = "[Followup] = " & Me.Followup
Forms("frmMain").FilterOn = True
End If
'/////// CLIENT
If Not IsNull(Me.Client) Then
Forms("frmMain").Filter = "[Client] = " & Me.Client
Forms("frmMain").FilterOn = True
End If
'/////// COMPANY
'If Not IsNull(Me.CompanyInfo_ID) Then
' Forms("frmMain").Filter = "[CompanyInfo_ID] Like " & Chr(34) & "*" & Me.CompanyInfo_ID & "*" & Chr(34)
' Forms("frmMain").FilterOn = True
'End If
'/////// CONTACT PERSON
If Not IsNull(Me.ContactPerson) Then
Forms("frmMain").Filter = "[ContactPerson] Like " & Chr(34) & "*" & Me.ContactPerson & "*" & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// STATUS
If Not IsNull(Me.Status) Then
Forms("frmMain").Filter = "[Status] = " & Chr(34) & Me.Status & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// EMAIL
If Not IsNull(Me.Email) Then
Forms("frmMain").Filter = "[Email] Like " & Chr(34) & "*" & Me.Email & "*" & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// REMARKS
If Not IsNull(Me.Remarks) Then
Forms("frmMain").Filter = "[Remarks] Like " & Chr(34) & "*" & Me.Remarks & "*" & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// CATEGORY
If Not IsNull(Me.CatergoryInfo_ID) Then
Forms("frmMain").Filter = "[CatergoryInfo_ID] = " & Me.CatergoryInfo_ID
Forms("frmMain").FilterOn = True
End If
'/////// CITY
If Not IsNull(Me.City) Then
Forms("frmMain").Filter = "[Full Address] Like " & Chr(34) & "*" & Me.City & "*" & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// ADDRESS
If Not IsNull(Me.Address) Then
Forms("frmMain").Filter = "[Full Address] Like " & Chr(34) & "*" & Me.Address & "*" & Chr(34)
Forms("frmMain").FilterOn = True
End If
'/////// COUNTRY
If Not IsNull(Me.CountryInfo_ID) Then
Forms("frmMain").Filter = "[CountryInfo_ID] = " & Me.CountryInfo_ID
Forms("frmMain").FilterOn = True
End If
End Sub
frmUpdate
Code:
Option Compare Database
Option Explicit
Private Sub btnClose_Click()
On Error GoTo Err_Catch
Me.Undo
DoCmd.Close
btnClose_Click:
Exit Sub
Err_Catch:
MsgBox Err.Description
Resume btnClose_Click
End Sub
Private Sub CatergoryInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("CatergoryInfo", dbOpenDynaset)
If vbYes = MsgBox("Category is not in the list. Do you wish to add " _
& NewData & " as a new Category?", _
vbYesNo + vbInformation, _
"New Category") Then
rst.AddNew
rst!Category = NewData
rst.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
leave:
If Not rst Is Nothing Then
rst.Close: Set rst = Nothing
End If
Exit Sub
myError:
MsgBox "Error " & Err.Number & ": " & Error$
Resume leave
End Sub
Private Sub CompanyInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("CompanyInfo", dbOpenDynaset)
If vbYes = MsgBox("Company name is not in the list. Do you wish to add " _
& NewData & " as a new Company?", _
vbYesNo + vbInformation, _
"New Company") Then
rst.AddNew
rst!CompanyName = NewData
rst.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
leave:
If Not rst Is Nothing Then
rst.Close: Set rst = Nothing
End If
Exit Sub
myError:
MsgBox "Error " & Err.Number & ": " & Error$
Resume leave
End Sub
Private Sub Email_AfterUpdate()
If IsNull(Me.Email.Value) Then
Me.cmbEmailStatus.Value = Null
Else
Me.cmbEmailStatus.Value = "NEW"
End If
End Sub
Private Sub PositionInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("PositionInfo", dbOpenDynaset)
If vbYes = MsgBox("Position is not in the list. Do you wish to add " _
& NewData & " as a new Position?", _
vbYesNo + vbInformation, _
"New Position") Then
rst.AddNew
rst!Position = NewData
rst.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
leave:
If Not rst Is Nothing Then
rst.Close: Set rst = Nothing
End If
Exit Sub
myError:
MsgBox "Error " & Err.Number & ": " & Error$
Resume leave
End Sub