R
Ross
I have a form that picks up records from a src tbl & adds a series of dates
based upon the src tbl info into a temporary tbl.
There are two loops - the outer loop moves through each record returned from
the src tbl & the inner loop picks up the from & to date specified in the src
tbl & determines the list of dates to be added to the dest tbl.
The dummy data has two records returned from ther src tbl and the first
record works fine - it picks up the first date & populates the dest tbl with
that date & each successive date in between & the end date (1 day at a time).
However, when it gets to the 2nd record in the src tbl the inner loop for
some reason then adds one month instead of one day to the dest tbl. Ihave
checked the dates calculated with the DateAdd function & it is returning the
correct dates but something must be happening with the INSERT INTO statement
that is executed.
Hope somebody can throw some light on this.
Private Sub cmdShowRecords_Click()
' Code Header inserted by the Procedure Header Add-In
'=============================================================
' Form_ztfdlgClientUnavailList.cmdShowRecords_Click
'-------------------------------------------------------------
' Purpose: adds records to the table zstblClientUnavailDateList _
according to the data in the tables tblClientUnavail _
and tblClientUnavailDates but limited to the Client _
specified in the Select Client combo box
' Author : Ross Petersen, 09-29-2004
' Notes :
'-------------------------------------------------------------
' Parameters
'-----------
'
'-------------------------------------------------------------
' Returns:
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' 09-29-2004 RP:
'=============================================================
' End Code Header block
Dim cnn As ADODB.Connection
Dim rsSrc As ADODB.Recordset
Dim strSQL As String
Dim strDelSQL As String
Dim strInsSQL As String
Dim dteToDate As Date
Dim dteCurDate As Date
Dim lngUnavail As Long
Dim strMsg As String
Dim strTitle As String
Dim boolNoRecs As Boolean
On Error GoTo HandleErr
boolNoRecs = False
Set cnn = New ADODB.Connection
Set cnn = CurrentProject.Connection
Set rsSrc = New ADODB.Recordset
'clear out the temporary table
strDelSQL = "DELETE * FROM zstblClientUnavailDateList"
cnn.Execute strDelSQL, adExecuteNoRecords, adCmdText
'SQL to pick up records from the source tbls but limited to the _
Client specified in the combo box
strSQL = "SELECT ClientUnavailDateID, " _
& "tblClientUnavailDates.ClientUnavailID, " _
& "UnavailDateFrom, " _
& "UnavailDateTo, " _
& "tblClientUnavail.ClientID " _
& "FROM tblClientUnavail " _
& "INNER JOIN tblClientUnavailDates " _
& "ON tblClientUnavail.ClientUnavailID =
tblClientUnavailDates.ClientUnavailID " _
& "WHERE tblclientunavail.ClientID = " & Me.cboSelectClient
'open recordset on the src tbls
With rsSrc
.ActiveConnection = cnn
.CursorLocation = adUseServer
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open strSQL, , , , adCmdText
'check to see if there are any records returned, If so, show message
to user & exit
If .RecordCount = 0 Then
strMsg = "Sorry, there are no dates recorded for " &
Me.cboSelectClient.Column(1) & " as being unavailable."
strTitle = "No unavailable dates for " &
Me.cboSelectClient.Column(1) & "."
DoCmd.Beep
MsgBox strMsg, vbInformation + vbOKOnly, strTitle
boolNoRecs = True
GoTo ExitHere
End If
.MoveFirst
'loop through each record that is returned from the src table
Do
'check to see if an entry has been made in the ToDate text box _
that it is not before the src table [UnavailDateFrom] field
If Not IsNull(Me.txtToDate) Then
If CDate(Me.txtToDate) < ![UnavailDateFrom] Then
strMsg = "Sorry, but the first Date that the Client is
unavailable is after the end date you have specified that you wish to see."
strTitle = "Invalid To Date specified."
DoCmd.Beep
MsgBox strMsg, vbInformation + vbOKOnly, strTitle
boolNoRecs = True
GoTo ExitHere
End If
End If
lngUnavail = ![ClientUnavailDateID]
'If lngUnavail = 2 Then Stop
'determine To Date
If IsNull(Me.txtToDate) Then
If IsNull(![UnavailDateTo]) Then
dteToDate = DateAdd("m", GetDefaultPopDatePeriod,
![UnavailDateFrom])
Else
dteToDate = ![UnavailDateTo]
End If
Else
If IsNull(![UnavailDateTo]) Then
dteToDate = CDate(Me.txtToDate)
Else
If ![UnavailDateTo] > CDate(Me.txtToDate) Then
dteToDate = Me.txtToDate
Else
dteToDate = ![UnavailDateTo]
End If
End If
End If
dteCurDate = ![UnavailDateFrom]
'start inner loop to populate Dest tbl with successive dates
between & incl the _
from & to dates in src tbls
Do
strInsSQL = "INSERT INTO zstblClientUnavailDateList
(ClientUnavailDateID, StdDate) " _
& "VALUES(" & lngUnavail & ", #" & dteCurDate & "#)"
cnn.Execute strInsSQL, adExecuteNoRecords, adCmdText
dteCurDate = DateAdd("d", 1, dteCurDate)
Loop Until dteCurDate > dteToDate
'move to next record from stc tbls then check if reached EOF
.MoveNext
Loop Until .EOF
End With
'show detail section - this includes a subform that is bound to the Dest
tbl
Me.Detail.Visible = True
ExitHere:
'close object variables & clean up
If Not rsSrc Is Nothing Then
If rsSrc.State <> adStateClosed Then
rsSrc.Close
End If
End If
If Not cnn Is Nothing Then
If cnn.State <> adStateClosed Then
cnn.Close
End If
End If
Set rsSrc = Nothing
Set cnn = Nothing
If boolNoRecs = False Then
Me.fsubClientUnavailDateList.Visible = True
Me.fsubClientUnavailDateList.Form.RecordSource = _
" SELECT zstblClientUnavailDateList.* " _
& "FROM zstblClientUnavailDateList " _
& "ORDER BY zstblClientUnavailDateList.StdDate"
End If
Exit Sub
' Error handling block added by Error Handler Add-In. DO NOT EDIT this block
of code.
' Automatic error handler last updated at 09-29-2004 09:29:27
'ErrorHandler:$$D=09-29-2004 'ErrorHandler:$$T=09:29:27
HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Form_ztfdlgClientUnavailList.cmdShowRecords_Click"
'ErrorHandler:$$N=Form_ztfdlgClientUnavailList.cmdShowRecords_Click
Resume ExitHere
End Select
' End Error handling block.
End Sub
based upon the src tbl info into a temporary tbl.
There are two loops - the outer loop moves through each record returned from
the src tbl & the inner loop picks up the from & to date specified in the src
tbl & determines the list of dates to be added to the dest tbl.
The dummy data has two records returned from ther src tbl and the first
record works fine - it picks up the first date & populates the dest tbl with
that date & each successive date in between & the end date (1 day at a time).
However, when it gets to the 2nd record in the src tbl the inner loop for
some reason then adds one month instead of one day to the dest tbl. Ihave
checked the dates calculated with the DateAdd function & it is returning the
correct dates but something must be happening with the INSERT INTO statement
that is executed.
Hope somebody can throw some light on this.
Private Sub cmdShowRecords_Click()
' Code Header inserted by the Procedure Header Add-In
'=============================================================
' Form_ztfdlgClientUnavailList.cmdShowRecords_Click
'-------------------------------------------------------------
' Purpose: adds records to the table zstblClientUnavailDateList _
according to the data in the tables tblClientUnavail _
and tblClientUnavailDates but limited to the Client _
specified in the Select Client combo box
' Author : Ross Petersen, 09-29-2004
' Notes :
'-------------------------------------------------------------
' Parameters
'-----------
'
'-------------------------------------------------------------
' Returns:
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' 09-29-2004 RP:
'=============================================================
' End Code Header block
Dim cnn As ADODB.Connection
Dim rsSrc As ADODB.Recordset
Dim strSQL As String
Dim strDelSQL As String
Dim strInsSQL As String
Dim dteToDate As Date
Dim dteCurDate As Date
Dim lngUnavail As Long
Dim strMsg As String
Dim strTitle As String
Dim boolNoRecs As Boolean
On Error GoTo HandleErr
boolNoRecs = False
Set cnn = New ADODB.Connection
Set cnn = CurrentProject.Connection
Set rsSrc = New ADODB.Recordset
'clear out the temporary table
strDelSQL = "DELETE * FROM zstblClientUnavailDateList"
cnn.Execute strDelSQL, adExecuteNoRecords, adCmdText
'SQL to pick up records from the source tbls but limited to the _
Client specified in the combo box
strSQL = "SELECT ClientUnavailDateID, " _
& "tblClientUnavailDates.ClientUnavailID, " _
& "UnavailDateFrom, " _
& "UnavailDateTo, " _
& "tblClientUnavail.ClientID " _
& "FROM tblClientUnavail " _
& "INNER JOIN tblClientUnavailDates " _
& "ON tblClientUnavail.ClientUnavailID =
tblClientUnavailDates.ClientUnavailID " _
& "WHERE tblclientunavail.ClientID = " & Me.cboSelectClient
'open recordset on the src tbls
With rsSrc
.ActiveConnection = cnn
.CursorLocation = adUseServer
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open strSQL, , , , adCmdText
'check to see if there are any records returned, If so, show message
to user & exit
If .RecordCount = 0 Then
strMsg = "Sorry, there are no dates recorded for " &
Me.cboSelectClient.Column(1) & " as being unavailable."
strTitle = "No unavailable dates for " &
Me.cboSelectClient.Column(1) & "."
DoCmd.Beep
MsgBox strMsg, vbInformation + vbOKOnly, strTitle
boolNoRecs = True
GoTo ExitHere
End If
.MoveFirst
'loop through each record that is returned from the src table
Do
'check to see if an entry has been made in the ToDate text box _
that it is not before the src table [UnavailDateFrom] field
If Not IsNull(Me.txtToDate) Then
If CDate(Me.txtToDate) < ![UnavailDateFrom] Then
strMsg = "Sorry, but the first Date that the Client is
unavailable is after the end date you have specified that you wish to see."
strTitle = "Invalid To Date specified."
DoCmd.Beep
MsgBox strMsg, vbInformation + vbOKOnly, strTitle
boolNoRecs = True
GoTo ExitHere
End If
End If
lngUnavail = ![ClientUnavailDateID]
'If lngUnavail = 2 Then Stop
'determine To Date
If IsNull(Me.txtToDate) Then
If IsNull(![UnavailDateTo]) Then
dteToDate = DateAdd("m", GetDefaultPopDatePeriod,
![UnavailDateFrom])
Else
dteToDate = ![UnavailDateTo]
End If
Else
If IsNull(![UnavailDateTo]) Then
dteToDate = CDate(Me.txtToDate)
Else
If ![UnavailDateTo] > CDate(Me.txtToDate) Then
dteToDate = Me.txtToDate
Else
dteToDate = ![UnavailDateTo]
End If
End If
End If
dteCurDate = ![UnavailDateFrom]
'start inner loop to populate Dest tbl with successive dates
between & incl the _
from & to dates in src tbls
Do
strInsSQL = "INSERT INTO zstblClientUnavailDateList
(ClientUnavailDateID, StdDate) " _
& "VALUES(" & lngUnavail & ", #" & dteCurDate & "#)"
cnn.Execute strInsSQL, adExecuteNoRecords, adCmdText
dteCurDate = DateAdd("d", 1, dteCurDate)
Loop Until dteCurDate > dteToDate
'move to next record from stc tbls then check if reached EOF
.MoveNext
Loop Until .EOF
End With
'show detail section - this includes a subform that is bound to the Dest
tbl
Me.Detail.Visible = True
ExitHere:
'close object variables & clean up
If Not rsSrc Is Nothing Then
If rsSrc.State <> adStateClosed Then
rsSrc.Close
End If
End If
If Not cnn Is Nothing Then
If cnn.State <> adStateClosed Then
cnn.Close
End If
End If
Set rsSrc = Nothing
Set cnn = Nothing
If boolNoRecs = False Then
Me.fsubClientUnavailDateList.Visible = True
Me.fsubClientUnavailDateList.Form.RecordSource = _
" SELECT zstblClientUnavailDateList.* " _
& "FROM zstblClientUnavailDateList " _
& "ORDER BY zstblClientUnavailDateList.StdDate"
End If
Exit Sub
' Error handling block added by Error Handler Add-In. DO NOT EDIT this block
of code.
' Automatic error handler last updated at 09-29-2004 09:29:27
'ErrorHandler:$$D=09-29-2004 'ErrorHandler:$$T=09:29:27
HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Form_ztfdlgClientUnavailList.cmdShowRecords_Click"
'ErrorHandler:$$N=Form_ztfdlgClientUnavailList.cmdShowRecords_Click
Resume ExitHere
End Select
' End Error handling block.
End Sub