Adding Record to Table

[Paul3rd]

Hello, my form uses a calendar control to display records. I'm trying to add
a record when the user chooses a date for which there is no record.
I used a combo box (cboApptDate) to display the date chosen by the calendar,
(Date being the default) and on the MouseDown event the calendar (Calendar5)
pops up so the user may choose another date.
That value is loaded in the combo box, and the underlying record
with matching "ApptDate" is displayed.
The code to accomplish this is as follows:


Private Sub cboApptDate_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As

Single)
'Unhide the calendar and give it the focus.
Calendar5.Visible = True
Calendar5.SetFocus
'Match calendar date to existing date if present or today's date.
If Not IsNull(cboApptDate) Then
Calendar5.Value = cboApptDate.Value
Else
Calendar5.Value = Date
End If

End Sub

Private Sub Calendar5_Click()
'Copy chosen date from calendar to originating combo box.
cboApptDate.Value = Calendar5.Value
'Return the focus to the combo box and hide the calendar.
cboApptDate.SetFocus
Calendar5.Visible = False
End Sub

Private Sub Calendar5_AfterUpdate()
'This matches the value selected by the calendar to
'a record in the Appt table with the same date.
Me.RecordsetClone.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
With Me.RecordsetClone
.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
If Not .NoMatch Then
Me.Bookmark = .Bookmark
End If
End With
End Sub

Private Sub Form_Load()
Dim rst As Object
Dim strCriteria As String

strCriteria = "[ApptDate] = #" & Date & "#"
'This opens the form onto todays date

Set rst = Me.RecordsetClone
rst.FindFirst strCriteria

If Not rst.EOF Then
Me.Bookmark = rst.Bookmark
End If

End Sub

I believe the new code for the Calendar5_AfterUpdate event should be
something like:

Private Sub Calendar5_AfterUpdate()
Dim mySQL As String
mySQL = "INSERT INTO ApptDispatch (ApptDate)"
mySQL = mySQL + " VALUES (#" & Date & "#)"
'This matches the value selected by the calendar to
'a record in the Appt table with the same date.
Me.RecordsetClone.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
With Me.RecordsetClone
.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
If Not .NoMatch Then
Me.Bookmark = .Bookmark
If .NoMatch Then
DoCmd.RunSQL mySQL
Me.Requery
Me.Bookmark = .Bookmark
End If
End If

End With
End Sub
That compiles OK but it does not return a new record.
I've been working on this many hours, if you have any
ideas I'd be grateful.
Thanks again,

 

[Steve Sanford]

Try this:

'------beg code-----------------------
Private Sub Calendar5_AfterUpdate()
Dim mySQL As String

mySQL = "INSERT INTO ApptDispatch (ApptDate)"
mySQL = mySQL & " VALUES (#" & Me![Calendar5] & "#)"

'This matches the value selected by the calendar to
'a record in the Appt table with the same date.
With Me.RecordsetClone
.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
Dim Msg, Style, Title, Response
Msg = "Do you want to add this date ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define
buttons.
Title = "Do You REALLY want to?" ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
'=== keep these===
'add new record
CurrentDb.Execute mySQL, dbFailOnError
Me.Requery
'=== keep these===
End If
End If
End With
End Sub
'------end code-----------------------


If you don't want the message box, delete the lines after the 'Else' except
the two lines between the '=== keep these=== lines

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

Hello, my form uses a calendar control to display records. I'm trying to add
a record when the user chooses a date for which there is no record.
I used a combo box (cboApptDate) to display the date chosen by the calendar,
(Date being the default) and on the MouseDown event the calendar (Calendar5)
pops up so the user may choose another date.
That value is loaded in the combo box, and the underlying record
with matching "ApptDate" is displayed.
The code to accomplish this is as follows:


Private Sub cboApptDate_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As

Single)
'Unhide the calendar and give it the focus.
Calendar5.Visible = True
Calendar5.SetFocus
'Match calendar date to existing date if present or today's date.
If Not IsNull(cboApptDate) Then
Calendar5.Value = cboApptDate.Value
Else
Calendar5.Value = Date
End If

End Sub

Private Sub Calendar5_Click()
'Copy chosen date from calendar to originating combo box.
cboApptDate.Value = Calendar5.Value
'Return the focus to the combo box and hide the calendar.
cboApptDate.SetFocus
Calendar5.Visible = False
End Sub

Private Sub Calendar5_AfterUpdate()
'This matches the value selected by the calendar to
'a record in the Appt table with the same date.
Me.RecordsetClone.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
With Me.RecordsetClone
.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
If Not .NoMatch Then
Me.Bookmark = .Bookmark
End If
End With
End Sub

Private Sub Form_Load()
Dim rst As Object
Dim strCriteria As String

strCriteria = "[ApptDate] = #" & Date & "#"
'This opens the form onto todays date

Set rst = Me.RecordsetClone
rst.FindFirst strCriteria

If Not rst.EOF Then
Me.Bookmark = rst.Bookmark
End If

End Sub

I believe the new code for the Calendar5_AfterUpdate event should be
something like:

Private Sub Calendar5_AfterUpdate()
Dim mySQL As String
mySQL = "INSERT INTO ApptDispatch (ApptDate)"
mySQL = mySQL + " VALUES (#" & Date & "#)"
'This matches the value selected by the calendar to
'a record in the Appt table with the same date.
Me.RecordsetClone.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
With Me.RecordsetClone
.FindFirst "[ApptDate] = #" & Me![Calendar5] & "#"
If Not .NoMatch Then
Me.Bookmark = .Bookmark
If .NoMatch Then
DoCmd.RunSQL mySQL
Me.Requery
Me.Bookmark = .Bookmark
End If
End If

End With
End Sub
That compiles OK but it does not return a new record.
I've been working on this many hours, if you have any
ideas I'd be grateful.
Thanks again,