Hi all HELP WANTED!!!!
I have the code below which is to populate a calender fromat on a form called reserve. When the PopulateCalendar sub is called i get a Type Mismatch.....can anyone find the issue / location of the Mismatch for me......
Thanks!!!!!!!!!!!!!!!!
I have the code below which is to populate a calender fromat on a form called reserve. When the PopulateCalendar sub is called i get a Type Mismatch.....can anyone find the issue / location of the Mismatch for me......
Code:
Private Sub PopulateCalendar()
On Error GoTo Err_PopulateCalendar
Dim strFirstOfMonth As String, bytFirstWeekdayOfMonth As Byte, bytBlockCounter As Byte
Dim bytBlockDayOfMonth As Byte, lngBlockDate As Long, ctlDayBlock As TextBox
Dim bytDaysInMonth As Byte, bytEventDayOfMonth As Byte, lngFirstOfMonth As Long
Dim lngLastOfMonth As Long, lngFirstOfNextMonth As Long, lngLastOfPreviousMonth As Long
Dim lngEventDate As Long, bytBlankBlocksBefore As Byte, bytBlankBlocksAfter As Byte
Dim astrCalendarBlocks(1 To 42) As String, db As DAO.Database, rstEvents As DAO.Recordset
Dim strEvent As String
Dim lngSystemDate As Long
Dim ctlSystemDateBlock As TextBox, blnSystemDateIsShown As Boolean
Dim strSQL As String
Dim lngFirstDateInRange As Long
Dim lngLastDateInRange As Long
Dim lngEachDateInRange As Long
'Dim strStartTime As String
lngSystemDate = Date
intMonth = objCurrentDate.Month
intYear = objCurrentDate.Year
'lblMonth.Caption = MonthAndYear(intMonth, intYear)
strFirstOfMonth = "/1/" & Str(intMonth) & Str(intYear)
bytFirstWeekdayOfMonth = Weekday(strFirstOfMonth)
lngFirstOfMonth = DateSerial(intYear, intMonth, 1)
lngFirstOfNextMonth = DateSerial(intYear, intMonth + 1, 1)
lngLastOfMonth = lngFirstOfNextMonth - 1
lngLastOfPreviousMonth = lngFirstOfMonth - 1
bytDaysInMonth = lngFirstOfNextMonth - lngFirstOfMonth
bytBlankBlocksBefore = bytFirstWeekdayOfMonth - 1
bytBlankBlocksAfter = 42 - (bytBlankBlocksBefore + bytDaysInMonth)
Set db = CurrentDb
'<SQL query to set recordset>
strSQL = "Select AllTransReservCalendar.[Job Number], AllTransReservCalendar.[Initials], AllTransReservCalendar.[Checked Out Date], " & _
"AllTransReservCalendar.[In Date] From AllTransReservCalendar Where AllTransReservCalendar.[Checked Out Date] " & _
"Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _
" or AllTransReservCalendar.[In Date] Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _
" or (AllTransReservCalendar.[Checked Out Date] < " & lngFirstOfMonth & _
" and AllTransReservCalendar.[In Date] > " & lngLastOfMonth & ")" & _
" ORDER BY AllTransReservCalendar.[Checked Out Date];"
Set rstEvents = db.OpenRecordset(strSQL)
Do While Not rstEvents.EOF
lngFirstDateInRange = rstEvents![Checked Out Date] '<Substitute for [Start Date]>
If lngFirstDateInRange < lngFirstOfMonth Then
lngFirstDateInRange = lngFirstOfMonth
End If
lngLastDateInRange = rstEvents![In Date] '<Substitute for [End Date]>
If lngLastDateInRange > lngLastOfMonth Then
lngLastDateInRange = lngLastOfMonth
End If
For lngEachDateInRange = lngFirstDateInRange To lngLastDateInRange
bytEventDayOfMonth = (lngEachDateInRange - lngLastOfPreviousMonth)
bytBlockCounter = bytEventDayOfMonth + bytBlankBlocksBefore
'If IsNull(rstEvents![Start Time]) Then ''''<Substitute for [Start Time]>
'strStartTime = ""
'Else
'strStartTime = Format$(rstEvents![Start Time], "Short Time") ''''<Substitute for [Start Time]>
''''strStartTime = Format$(rstEvents![Start Time], "h:mm AM/PM") ''''<Substitute for [Start Time]>
'End If
'<Substitute for [Title]>
If astrCalendarBlocks(bytBlockCounter) = "" Then
astrCalendarBlocks(bytBlockCounter) = rstEvents![Job Number] & vbNewLine & rstEvents![Initials]
Else '<Substitute for [Title]>
astrCalendarBlocks(bytBlockCounter) = astrCalendarBlocks(bytBlockCounter) & vbNewLine & _
rstEvents![Job Number] & vbNewLine & rstEvents![Initials]
End If
Next lngEachDateInRange
rstEvents.MoveNext
Loop
For bytBlockCounter = 1 To 42 'blank blocks at start of month
Select Case bytBlockCounter
Case Is < bytFirstWeekdayOfMonth
astrCalendarBlocks(bytBlockCounter) = ""
ReferenceABlock ctlDayBlock, bytBlockCounter
ctlDayBlock.BackColor = 12632256
ctlDayBlock = ""
ctlDayBlock.Enabled = False
ctlDayBlock.Tag = ""
Case Is > bytBlankBlocksBefore + bytDaysInMonth 'blank blocks at end of month
astrCalendarBlocks(bytBlockCounter) = ""
ReferenceABlock ctlDayBlock, bytBlockCounter
ctlDayBlock.BackColor = 12632256
ctlDayBlock = ""
ctlDayBlock.Enabled = False
ctlDayBlock.Tag = ""
ctlDayBlock.Visible = Not (bytBlankBlocksAfter > 6 And bytBlockCounter > 35)
Case Else 'blocks that hold days of the month
bytBlockDayOfMonth = bytBlockCounter - bytBlankBlocksBefore
ReferenceABlock ctlDayBlock, bytBlockCounter
lngBlockDate = lngLastOfPreviousMonth + bytBlockDayOfMonth 'block's date
If bytBlockDayOfMonth < 10 Then
ctlDayBlock = Space(2) & bytBlockDayOfMonth & _
vbNewLine & astrCalendarBlocks(bytBlockCounter)
Else
ctlDayBlock = bytBlockDayOfMonth & _
vbNewLine & astrCalendarBlocks(bytBlockCounter)
End If
'If this block is the system date, change its color (CFB 1-25-08)
If lngBlockDate = lngSystemDate Then
ctlDayBlock.BackColor = RGB(0, 0, 255)
ctlDayBlock.ForeColor = QBColor(15)
Set ctlSystemDateBlock = ctlDayBlock
blnSystemDateIsShown = True
Else
ctlDayBlock.BackColor = QBColor(15)
ctlDayBlock.ForeColor = 8388608
End If
ctlDayBlock.Visible = True
ctlDayBlock.Enabled = True
ctlDayBlock.Tag = lngBlockDate
End Select
Next
Exit_PopulateCalendar:
Exit Sub
Err_PopulateCalendar:
MsgBox Err.Description, vbExclamation, "Error inPopulateCalendar()"
Resume Exit_PopulateCalendar
End Sub
Thanks!!!!!!!!!!!!!!!!