Code Problem

[xeb]

Hi:

I have a problem with a form that is running code. When the user clicks "Append Data" the data is posted okay but the date in the form is highlighted in black so my users aren't sure if the data was posted which is causng them to click "Append Data" again. What I want is for the data to disappear and a blank form to appear ready for the next record.

This is the code:

Private Sub cmdAppendRecords_Click()
' Code Header inserted by VBA Code Commenter and Error Handler Add-In
'=============================================================
' Form_frmXebEntry.cmdAppendRecords_Click

' End Code Header block
Dim db As DAO.Database
Dim strSQL As String
Dim intBox As Integer
Dim strBox As String 'name of 1 of 50 text boxes

On Error GoTo HandleErr

If Not IsDate(Me.txtDate) Then
MsgBox "You must enter a date"
Me.txtDate.SetFocus
Exit Sub
End If
strSQL = "DELETE FROM tsData WHERE tdTSID = " & Me.tsTsID
Set db = CurrentDb
'clear out any existing records before appending new values
db.Execute strSQL, dbFailOnError
For intBox = 1 To 50
strBox = "Text" & intBox
If Not IsNull(Me(strBox)) Then
strSQL = "Insert Into tsData (tdTSID, tdCol, tdValue) " & _
" Values(" & Me.tsTsID & ", " & intBox & ", " & Me("text" & intBox) & ")"
db.Execute strSQL, dbFailOnError
End If
Next
Me.txtDate.SetFocus

ExitHere:
On Error Resume Next
'Close objects and set to nothing
Set db = Nothing
Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
' Automatic error handler last updated at Saturday, February 28, 2004 12:17:09 AM
HandleErr:
Select Case Err.Number
Case 3022 'this data would create duplicates in table
MsgBox "You have already added data for this date.", vbOKOnly + vbInformation, "Duplicate Dates"
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Form_frmXebEntry.cmdAppendRecords_Click"
End Select

Resume ExitHere
' End Error handling block.
End Sub


Thanks,

xeb

 

[pdldavis]

DoCmd.GoToRecord , , acNewRec ?

 

[KenReay]

Hi

How about:

Private Sub cmdAppendRecords_Click()
' Code Header inserted by VBA Code Commenter and Error Handler Add-In
'=============================================================
' Form_frmXebEntry.cmdAppendRecords_Click

' End Code Header block
Dim db As DAO.Database
Dim strSQL As String
Dim intBox As Integer
Dim strBox As String 'name of 1 of 50 text boxes

On Error GoTo HandleErr

If Not IsDate(Me.txtDate) Then
MsgBox "You must enter a date"
Me.txtDate.SetFocus
Exit Sub
End If
strSQL = "DELETE FROM tsData WHERE tdTSID = " & Me.tsTsID
Set db = CurrentDb
'clear out any existing records before appending new values
db.Execute strSQL, dbFailOnError
For intBox = 1 To 50
strBox = "Text" & intBox
If Not IsNull(Me(strBox)) Then
strSQL = "Insert Into tsData (tdTSID, tdCol, tdValue) " & _
" Values(" & Me.tsTsID & ", " & intBox & ", " & Me("text" & intBox) & ")"
db.Execute strSQL, dbFailOnError
End If
Next

For intBox = 1 To 50 <---------
Me("Text" & intBox) = "" <---------
Next <---------
Me.txtDate.SetFocus

ExitHere:
On Error Resume Next
'Close objects and set to nothing
Set db = Nothing
Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
' Automatic error handler last updated at Saturday, February 28, 2004 12:17:09 AM
HandleErr:
Select Case Err.Number
Case 3022 'this data would create duplicates in table
MsgBox "You have already added data for this date.", vbOKOnly + vbInformation, "Duplicate Dates"
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Form_frmXebEntry.cmdAppendRecords_Click"
End Select

Resume ExitHere
' End Error handling block.
End Sub



Regards

Ken Reay
Freelance Solutions Developer
Boldon Information Systems Ltd
Website needs upgrading, but for now -

http://www.kenneth.reay.btinternet.co.uk

UK

 

[xeb]

pdldavis:

I don't know code very well so can you show me exactly where that goes?

Thanks,

xeb

 

[pdldavis]

Hi, try:

End If
Next

DoCmd.GoToRecord , , acNewRec 'moves to a new record

Me.txtDate.SetFocus

ExitHere: