Overflow error followup

  • Thread starter Thread starter Mikev
  • Start date Start date
M

Mikev

Here is the code behind the save button and relavant
validation code as well as save entry procedure.
Good luck and TIA

Private Sub cmdSave_Click()
On Error GoTo HandleError

Dim blnValidEntry As Boolean

'Validate the Entry
blnValidEntry = ValidateEntry()

If blnValidEntry Then
SaveEntry
DoCmd.Close acForm, mTHISFORMNAME
End If

Done:
Exit Sub

HandleError:
DisplayError Err
Resume Done

End Sub
Private Function ValidateEntry() As Boolean
On Error GoTo HandleError
Dim blnValidPropDetails As Boolean

'Validate Property Details (if required)
mblnCreateRel = False
blnValidPropDetails = True
If Me.txtMapNumber.Visible = True Then
If Nz(Me.opgRelationship, 0) <> 0 And Nz
(Me.opgRelationship, 0) <> 4 Then
mblnCreateRel = True
' If Nz(Me.txtMapNumber, "") = "" Then
' gstrMsg = "You need to enter a Map Number."
' MsgBox gstrMsg, vbExclamation, gAPPNAME
' Me.txtMapNumber.SetFocus
' blnValidPropDetails = False
' ElseIf Nz(Me.txtMapReference, "") = "" Then
' gstrMsg = "You need to enter a Map Number."
' MsgBox gstrMsg, vbExclamation, gAPPNAME
' Me.txtMapReference.SetFocus
' blnValidPropDetails = False
' End If
End If
End If

'Were Property Details Valid
If blnValidPropDetails = False Then
ValidateEntry = False
'Validate Surname
ElseIf Nz(Me.txtSurname, "") = "" Then
gstrMsg = "You need to enter a surname."
MsgBox gstrMsg, vbExclamation, gAPPNAME
Me.txtSurname.SetFocus
ValidateEntry = False
'Validate StreetName
ElseIf Nz(Me.cboStreetName, "") = "" Then
gstrMsg = "You need to enter a street name."
MsgBox gstrMsg, vbExclamation, gAPPNAME
Me.cboStreetName.SetFocus
ValidateEntry = False
'Validate Suburb
ElseIf Nz(Me.cboSuburb, "") = "" Then
gstrMsg = "You need to enter a suburb."
MsgBox gstrMsg, vbExclamation, gAPPNAME
Me.cboSuburb.SetFocus
ValidateEntry = False
Else
ValidateEntry = True
End If



Done:
Exit Function

HandleError:
DisplayError Err
ValidateEntry = False
Resume Done
End Function

Public Sub SaveEntry()
On Error GoTo HandleError

Dim objProperty As clsProperty
Dim objPropertyRel As clsPropertyRelationship
Dim strUpdateType As String
Dim intKey As Integer

'Set the fields
mobjClient.Title = Nz(Me.cboTitle, "")
mobjClient.GivenName = Nz(Me.txtFirstName, "")
mobjClient.Surname = Nz(Me.txtSurname, "")
mobjClient.NameSuffix = Nz(Me.cboNameSuffix, "")
mobjClient.Salutation = Nz(Me.txtSalutation, "")
mobjClient.UnitNumber = Nz(Me.txtUnitNumber, "")
mobjClient.StreetNumber = Nz(Me.txtStreetNumber, "")
mobjClient.StreetName = Nz(Me.cboStreetName, "")
mobjClient.StreetType = Nz(Me.cboStreetType, "")
mobjClient.Suburb = Nz(Me.cboSuburb, "")
mobjClient.State = Nz(Me.cboState, "")
mobjClient.Postcode = Nz(Me.txtPostcode, "")
mobjClient.PhoneStdBH = Nz(Me.txtPhoneStdBH, "")
mobjClient.PhoneBH = Nz(Me.txtPhoneBH, "")
mobjClient.PhoneStdAH = Nz(Me.txtPhoneStdAH, "")
mobjClient.PhoneAH = Nz(Me.txtPhoneAH, "")
mobjClient.PhoneMobile = Nz(Me.txtPhoneMobile, "")
mobjClient.Email = Nz(Me.txtEmail, "")
mobjClient.FaxStd = Nz(Me.txtFaxStd, "")
mobjClient.Fax = Nz(Me.txtFax, "")
mobjClient.PermissionToEmail = Nz
(Me.chkPermissionToEmail, 0)
mobjClient.PermissionToSMS = Nz
(Me.chkPermissionToSMS, 0)
mobjClient.DateOfBirth = Nz(Me.txtDOB, 0)
mobjClient.Occupation = Nz(Me.txtOccupation, "")
mobjClient.BusinessName = Nz(Me.txtBusinessName, "")
mobjClient.BusinessUnitNumber = Nz
(Me.txtBusinessUnitNumber, "")
mobjClient.BusinessStreetNumber = Nz
(Me.txtBusinessStreetNumber, "")
mobjClient.BusinessStreetName = Nz
(Me.cboBusinessStreetName, "")
mobjClient.BusinessStreetType = Nz
(Me.cboBusinessStreetType, "")
mobjClient.BusinessSuburb = Nz
(Me.cboBusinessSuburb, "")
mobjClient.BusinessState = Nz
(Me.cboBusinessState, "")
mobjClient.BusinessPostcode = Nz
(Me.txtBusinessPostcode, "")
mobjClient.BusinessCountry = Nz
(Me.cboBusinessCountry, "")
mobjClient.BusinessPhoneStd = Nz
(Me.txtBusinessPhoneStd, "")
mobjClient.BusinessPhone = Nz
(Me.txtBusinessPhone, "")
mobjClient.BusinessFaxStd = Nz
(Me.txtBusinessFaxStd, "")
mobjClient.BusinessFax = Nz(Me.txtBusinessFax, "")
mobjClient.PAName = Nz(Me.txtPAName, "")
mobjClient.Notes = Nz(Me.txtNotes, "")

'Either update the exisitng record or create a new one
If mstrRecType = "E" Then
strUpdateType = "UPDATE"
mobjClient.UpdateEntry
Else
strUpdateType = "CREATE"
intKey = mobjClient.NextKey
If intKey = -1 Then
mstrGotoForm = mCLIENTSEARCHFORM
mstrOpenArgs = mstrSearchFormUse
Err.Raise 513, Me.Name & ":" &
Me.ActiveControl.Name, "Unable to get " & mKEYNAME & ". "
& mRECORDNAME & " was not created. Please contact your
System Administrator."
Else
mobjClient.ClientId = intKey
mintClientId = intKey
If mstrSearchFormUse = mCLIENTSEARCH Then
mstrGotoForm = mCLIENTVIEWFORM
mstrOpenArgs = mintClientId
End If
End If
mobjClient.CreateEntry

'Copy the temp Checklist to the actual checklist table
mobjChecklist.RecordId = mintClientId
mobjChecklist.LoadIntoActual

'Create the relationship if need be
If mblnCreateRel = True Then
'Check if the property already exists
Set objProperty = New clsProperty
objProperty.StreetName = Nz(Me.cboStreetName, "")
objProperty.StreetNumber = Nz(Me.txtStreetNumber, "")
objProperty.UnitNumber = Nz(Me.txtUnitNumber, "")
objProperty.Postcode = Nz(Me.txtPostcode, "")
If objProperty.CheckDuplicateProperty = True Then
mintPropertyId = objProperty.PropertyId
Else
'It does not - so create it
mintPropertyId = objProperty.NextKey
objProperty.PropertyId = mintPropertyId
objProperty.StreetType = Nz(Me.cboStreetType, "")
objProperty.Suburb = Nz(Me.cboSuburb, "")
objProperty.State = Nz(Me.cboState, "")
objProperty.Country = Nz(Me.cboCountry, "")
objProperty.YearBuilt = Nz(Me.txtYearBuilt, "")
objProperty.MapNumber = Nz(Me.txtMapNumber, "")
objProperty.MapReference = Nz
(Me.txtMapReference, "")
objProperty.CreateEntry
End If
Set objProperty = Nothing
'Create the relationship
Set objPropertyRel = New clsPropertyRelationship
objPropertyRel.PropertyRelId = objPropertyRel.NextKey
objPropertyRel.ActiveStatus = "A"
objPropertyRel.DateRelationshipStart = Now()
Select Case Me.opgRelationship
Case 1
objPropertyRel.PropertyRelationshipTypeId =
gOWNER
Case 2
objPropertyRel.PropertyRelationshipTypeId =
gLANDLORD
Case 3
objPropertyRel.PropertyRelationshipTypeId =
gTENANT
End Select
objPropertyRel.PropertyStatusId = gNOSTATUS
objPropertyRel.ClientId = mintClientId
objPropertyRel.PropertyId = mintPropertyId
objPropertyRel.StaffId = gintCurrStaffId
objPropertyRel.CreateEntry
Set objPropertyRel = Nothing
End If
End If

'Update the Audit Log
gstrMsg = mRECORDNAME & ": " & mobjClient.ClientId & " -
" & Me.txtFirstName & " " & Me.txtSurname
UpdateAuditLog gstrMsg, strUpdateType

mblnDirty = False
mblnSaved = True

Done:
Exit Sub

HandleError:
DisplayError Err
Resume Done
End Sub
 
Mikev said:
Here is the code behind the save button and relavant
validation code as well as save entry procedure.
Good luck and TIA

Private Sub cmdSave_Click()
On Error GoTo HandleError

Dim blnValidEntry As Boolean

'Validate the Entry
blnValidEntry = ValidateEntry()

If blnValidEntry Then
SaveEntry
DoCmd.Close acForm, mTHISFORMNAME
End If

Done:
Exit Sub

HandleError:
DisplayError Err
Resume Done

End Sub
Private Function ValidateEntry() As Boolean
On Error GoTo HandleError
Dim blnValidPropDetails As Boolean

'Validate Property Details (if required)
mblnCreateRel = False
blnValidPropDetails = True
If Me.txtMapNumber.Visible = True Then
If Nz(Me.opgRelationship, 0) <> 0 And Nz
(Me.opgRelationship, 0) <> 4 Then
mblnCreateRel = True
' If Nz(Me.txtMapNumber, "") = "" Then
' gstrMsg = "You need to enter a Map Number."
' MsgBox gstrMsg, vbExclamation, gAPPNAME
' Me.txtMapNumber.SetFocus
' blnValidPropDetails = False
' ElseIf Nz(Me.txtMapReference, "") = "" Then
' gstrMsg = "You need to enter a Map Number."
' MsgBox gstrMsg, vbExclamation, gAPPNAME
' Me.txtMapReference.SetFocus
' blnValidPropDetails = False
' End If
End If
End If

'Were Property Details Valid
If blnValidPropDetails = False Then
ValidateEntry = False
'Validate Surname
ElseIf Nz(Me.txtSurname, "") = "" Then
gstrMsg = "You need to enter a surname."
MsgBox gstrMsg, vbExclamation, gAPPNAME
Me.txtSurname.SetFocus
ValidateEntry = False
'Validate StreetName
ElseIf Nz(Me.cboStreetName, "") = "" Then
gstrMsg = "You need to enter a street name."
MsgBox gstrMsg, vbExclamation, gAPPNAME
Me.cboStreetName.SetFocus
ValidateEntry = False
'Validate Suburb
ElseIf Nz(Me.cboSuburb, "") = "" Then
gstrMsg = "You need to enter a suburb."
MsgBox gstrMsg, vbExclamation, gAPPNAME
Me.cboSuburb.SetFocus
ValidateEntry = False
Else
ValidateEntry = True
End If



Done:
Exit Function

HandleError:
DisplayError Err
ValidateEntry = False
Resume Done
End Function

Public Sub SaveEntry()
On Error GoTo HandleError

Dim objProperty As clsProperty
Dim objPropertyRel As clsPropertyRelationship
Dim strUpdateType As String
Dim intKey As Integer

'Set the fields
mobjClient.Title = Nz(Me.cboTitle, "")
mobjClient.GivenName = Nz(Me.txtFirstName, "")
mobjClient.Surname = Nz(Me.txtSurname, "")
mobjClient.NameSuffix = Nz(Me.cboNameSuffix, "")
mobjClient.Salutation = Nz(Me.txtSalutation, "")
mobjClient.UnitNumber = Nz(Me.txtUnitNumber, "")
mobjClient.StreetNumber = Nz(Me.txtStreetNumber, "")
mobjClient.StreetName = Nz(Me.cboStreetName, "")
mobjClient.StreetType = Nz(Me.cboStreetType, "")
mobjClient.Suburb = Nz(Me.cboSuburb, "")
mobjClient.State = Nz(Me.cboState, "")
mobjClient.Postcode = Nz(Me.txtPostcode, "")
mobjClient.PhoneStdBH = Nz(Me.txtPhoneStdBH, "")
mobjClient.PhoneBH = Nz(Me.txtPhoneBH, "")
mobjClient.PhoneStdAH = Nz(Me.txtPhoneStdAH, "")
mobjClient.PhoneAH = Nz(Me.txtPhoneAH, "")
mobjClient.PhoneMobile = Nz(Me.txtPhoneMobile, "")
mobjClient.Email = Nz(Me.txtEmail, "")
mobjClient.FaxStd = Nz(Me.txtFaxStd, "")
mobjClient.Fax = Nz(Me.txtFax, "")
mobjClient.PermissionToEmail = Nz
(Me.chkPermissionToEmail, 0)
mobjClient.PermissionToSMS = Nz
(Me.chkPermissionToSMS, 0)
mobjClient.DateOfBirth = Nz(Me.txtDOB, 0)
mobjClient.Occupation = Nz(Me.txtOccupation, "")
mobjClient.BusinessName = Nz(Me.txtBusinessName, "")
mobjClient.BusinessUnitNumber = Nz
(Me.txtBusinessUnitNumber, "")
mobjClient.BusinessStreetNumber = Nz
(Me.txtBusinessStreetNumber, "")
mobjClient.BusinessStreetName = Nz
(Me.cboBusinessStreetName, "")
mobjClient.BusinessStreetType = Nz
(Me.cboBusinessStreetType, "")
mobjClient.BusinessSuburb = Nz
(Me.cboBusinessSuburb, "")
mobjClient.BusinessState = Nz
(Me.cboBusinessState, "")
mobjClient.BusinessPostcode = Nz
(Me.txtBusinessPostcode, "")
mobjClient.BusinessCountry = Nz
(Me.cboBusinessCountry, "")
mobjClient.BusinessPhoneStd = Nz
(Me.txtBusinessPhoneStd, "")
mobjClient.BusinessPhone = Nz
(Me.txtBusinessPhone, "")
mobjClient.BusinessFaxStd = Nz
(Me.txtBusinessFaxStd, "")
mobjClient.BusinessFax = Nz(Me.txtBusinessFax, "")
mobjClient.PAName = Nz(Me.txtPAName, "")
mobjClient.Notes = Nz(Me.txtNotes, "")

'Either update the exisitng record or create a new one
If mstrRecType = "E" Then
strUpdateType = "UPDATE"
mobjClient.UpdateEntry
Else
strUpdateType = "CREATE"
intKey = mobjClient.NextKey
If intKey = -1 Then
mstrGotoForm = mCLIENTSEARCHFORM
mstrOpenArgs = mstrSearchFormUse
Err.Raise 513, Me.Name & ":" &
Me.ActiveControl.Name, "Unable to get " & mKEYNAME & ". "
& mRECORDNAME & " was not created. Please contact your
System Administrator."
Else
mobjClient.ClientId = intKey
mintClientId = intKey
If mstrSearchFormUse = mCLIENTSEARCH Then
mstrGotoForm = mCLIENTVIEWFORM
mstrOpenArgs = mintClientId
End If
End If
mobjClient.CreateEntry

'Copy the temp Checklist to the actual checklist table
mobjChecklist.RecordId = mintClientId
mobjChecklist.LoadIntoActual

'Create the relationship if need be
If mblnCreateRel = True Then
'Check if the property already exists
Set objProperty = New clsProperty
objProperty.StreetName = Nz(Me.cboStreetName, "")
objProperty.StreetNumber = Nz(Me.txtStreetNumber, "")
objProperty.UnitNumber = Nz(Me.txtUnitNumber, "")
objProperty.Postcode = Nz(Me.txtPostcode, "")
If objProperty.CheckDuplicateProperty = True Then
mintPropertyId = objProperty.PropertyId
Else
'It does not - so create it
mintPropertyId = objProperty.NextKey
objProperty.PropertyId = mintPropertyId
objProperty.StreetType = Nz(Me.cboStreetType, "")
objProperty.Suburb = Nz(Me.cboSuburb, "")
objProperty.State = Nz(Me.cboState, "")
objProperty.Country = Nz(Me.cboCountry, "")
objProperty.YearBuilt = Nz(Me.txtYearBuilt, "")
objProperty.MapNumber = Nz(Me.txtMapNumber, "")
objProperty.MapReference = Nz
(Me.txtMapReference, "")
objProperty.CreateEntry
End If
Set objProperty = Nothing
'Create the relationship
Set objPropertyRel = New clsPropertyRelationship
objPropertyRel.PropertyRelId = objPropertyRel.NextKey
objPropertyRel.ActiveStatus = "A"
objPropertyRel.DateRelationshipStart = Now()
Select Case Me.opgRelationship
Case 1
objPropertyRel.PropertyRelationshipTypeId =
gOWNER
Case 2
objPropertyRel.PropertyRelationshipTypeId =
gLANDLORD
Case 3
objPropertyRel.PropertyRelationshipTypeId =
gTENANT
End Select
objPropertyRel.PropertyStatusId = gNOSTATUS
objPropertyRel.ClientId = mintClientId
objPropertyRel.PropertyId = mintPropertyId
objPropertyRel.StaffId = gintCurrStaffId
objPropertyRel.CreateEntry
Set objPropertyRel = Nothing
End If
End If

'Update the Audit Log
gstrMsg = mRECORDNAME & ": " & mobjClient.ClientId & " -
" & Me.txtFirstName & " " & Me.txtSurname
UpdateAuditLog gstrMsg, strUpdateType

mblnDirty = False
mblnSaved = True

Done:
Exit Sub

HandleError:
DisplayError Err
Resume Done
End Sub
Click to expand...

It would have better to post this as a reply to the original thread;
you're lucky I didn't overlook this. Hmm, there's a whole lot going on
there, with classes and methods being called whose definitions aren't
included. Rather than wade through all the code, I'll ask you to set a
breakpoint on the cmdSave_Click procedure, and then step through the
code line by line until you come to the line that raises the error.
Then you can report back the specific line that caused the overflow.
 
Dirk,
Have done what you said and placed the breakpoint on the
cmdSave_click line and stepped through each line until i
got to here: the .CommandText line, the INSERT statement
is what i think is generating the error. Our max records
are set to 10000 and have looked into the tblAuditLog and
it is at 10000 records. Is this the problem or possible
datatype length limits on vchar LogDesc which is set to
100?
Thanks for the help
Mike

Public Sub UpdateAuditLog(strAuditEntry As String,
strAuditEvent As String)
On Error GoTo HandleError

Dim cn As ADODB.Connection
Dim cmdUpdateAuditLog As ADODB.Command
Dim intKey As Integer

'Use the ADO connection that Access uses
Set cn = CurrentProject.AccessConnection

Set cmdUpdateAuditLog = New ADODB.Command
With cmdUpdateAuditLog
Set .ActiveConnection = cn
intKey = GetNextKey(mLOGKEYNAME, mLOGTABLENAME)
If intKey = -1 Then
Err.Raise 513, "Audit Log: Unable to get " &
mLOGKEYNAME & ". Please contact your System Administrator."
End If
.CommandText = "INSERT INTO tblAuditLog (LogId,
StaffId, DateAdded, AuditEvent, LogDesc) VALUES (" &
intKey & "," & gintCurrStaffId & ", GETDATE(), '" &
strAuditEvent & "','" & strAuditEntry & "')"
.Execute
End With

Done:
Exit Sub

HandleError:
DisplayError Err
Resume Done
End Sub
 
MikeV said:
Dirk,
Have done what you said and placed the breakpoint on the
cmdSave_click line and stepped through each line until i
got to here: the .CommandText line, the INSERT statement
is what i think is generating the error. Our max records
are set to 10000 and have looked into the tblAuditLog and
it is at 10000 records. Is this the problem or possible
datatype length limits on vchar LogDesc which is set to
100?
Thanks for the help
Mike

Public Sub UpdateAuditLog(strAuditEntry As String,
strAuditEvent As String)
On Error GoTo HandleError

Dim cn As ADODB.Connection
Dim cmdUpdateAuditLog As ADODB.Command
Dim intKey As Integer

'Use the ADO connection that Access uses
Set cn = CurrentProject.AccessConnection

Set cmdUpdateAuditLog = New ADODB.Command
With cmdUpdateAuditLog
Set .ActiveConnection = cn
intKey = GetNextKey(mLOGKEYNAME, mLOGTABLENAME)
If intKey = -1 Then
Err.Raise 513, "Audit Log: Unable to get " &
mLOGKEYNAME & ". Please contact your System Administrator."
End If
.CommandText = "INSERT INTO tblAuditLog (LogId,
StaffId, DateAdded, AuditEvent, LogDesc) VALUES (" &
intKey & "," & gintCurrStaffId & ", GETDATE(), '" &
strAuditEvent & "','" & strAuditEntry & "')"
.Execute
End With

Done:
Exit Sub

HandleError:
DisplayError Err
Resume Done
End Sub
Click to expand...

So you're getting the error on the line that assigns a value to
..CommandText, not on the .Execute line? Are you sure?

I don't understand what you're saying about "max records", but I don't
see how it could be relevant if the error is being raised on the
assignment to the .CommandText property. Now, I'm not particularly
conversant with ADO, since I do most of my work wit MDB fields and DAO,
but I'd proceed to debug by capturing and printing out the SQL statement
before it is assigned to the .CommandText property. So I'd change this
line:
.CommandText = "INSERT INTO tblAuditLog (LogId,
StaffId, DateAdded, AuditEvent, LogDesc) VALUES (" &
intKey & "," & gintCurrStaffId & ", GETDATE(), '" &
strAuditEvent & "','" & strAuditEntry & "')"
Click to expand...

to this:

Dim strSQL As String

strSQL = _
"INSERT INTO tblAuditLog (" & _
"LogId, StaffId, DateAdded, AuditEvent, LogDesc" & _
") VALUES (" & _
intKey & "," & gintCurrStaffId & ", GETDATE(), '" & _
strAuditEvent & "','" & strAuditEntry & "')"

Debug.Print strSQL

.CommandText = strSQL

Then I'd step through and look at the SQL statement as it is printed in
the Immediate Window. Maybe it's invalid due to an embedded
single-quote in one of the string elements. Or maybe one of the values
you're trying to insert exceeds the defined maximum for the field you're
trying to insert it into, though in that case I'd expect the error to
occur when you call the .Execute method.
 
Back
Top