Good day. Is anyone here familiar with the coding for a calendar in Access? I am having an issue but I am not sure what i am doing wrong.
Good day. Is anyone here familiar with the coding for a calendar in Access? I am having an issue but I am not sure what i am doing wrong.
Nobody can help without knowing what exactly you're trying to do, and what's going wrong. Saying you're "having an issue" is no help at all.
Sorry about that. My database has several unrelated tables with renewal dates that I would like to add to the calendar. I wrote a union query and am trying to populate the calendar from it but it's not working. I am kind of a novice at the code writing aspect of Access. I will send the code shortly
Code was sent via PM:
Code:Option Explicit Private intMonth As Integer Private intYear As Integer Private lngFirstDayOfMonth As Long Private intFirstWeekday As Integer Private intDaysInMonth As Integer Private myArray() As Variant Private Sub Form_Load() With Me .cboMonth = Month(Date) .cboYear = Year(Date) End With Call Main End Sub Private Sub cboMonth_AfterUpdate() On Error GoTo ErrorHandler Call Main ExitSub: Exit Sub ErrorHandler: MsgBox "There has been an error. Please reload the form" Resume ExitSub End Sub Private Sub cboYear_AfterUpdate() On Error GoTo ErrorHandler Call Main ExitSub: Exit Sub ErrorHandler: MsgBox "There has been an error. Please reload the form" Resume ExitSub End Sub Private Sub Main() On Error GoTo ErrorHandler Call InitVariables Call InitArray Call LoadArray Call PrintArray ExitSub: Exit Sub ErrorHandler: MsgBox "There has been an error. Please reload the form" Resume ExitSub End Sub Private Sub InitVariables() On Error GoTo ErrorHandler intMonth = Me.cboMonth intYear = Me.cboYear lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1)) intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth) intDaysInMonth = getDaysInMonth(intMonth, intYear) ExitSub: Exit Sub ErrorHandler: MsgBox "There has been an error. Please reload the form" Resume ExitSub End Sub Private Sub InitArray() Dim i As Integer ReDim myArray(0 To 41, 0 To 2) For i = 0 To 41 myArray(i, 0) = lngFirstDayOfMonth - intFirstWeekday + 1 + i If Month(myArray(i, 0)) = intMonth Then myArray(i, 1) = True myArray(i, 2) = Day(myArray(i, 0)) Else myArray(i, 1) = False End If Next i End Sub Public Sub LoadArray() Dim db As DAO.Database Dim rs As DAO.Recordset Dim rsfiltered As DAO.Recordset Dim strSQL As String Dim i As Integer Dim d As Date d = Format(Now(), "Medium Date") strSQL = "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblBOILERCERTIFICATION]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblEQUIPMENTREGISTRATION]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblFACTORYCERTIFICATION]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblFIRECERTIFICATION]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblFOODHANDLINGCERTIFICATION]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblWELLLICENCES]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblLICENCES]UNION " _ & "SELECT [ID],[RENEWALDATE],[RENEWALDATEPROMPT]FROM [tblPERMITS];" Set db = CurrentDb Set rs = db.OpenRecordset(strSQL) If Not rs.BOF And Not rs.EOF Then For i = LBound(myArray) To UBound(myArray) rs.Filtered = "[RENEWALDATE]=" & myArray(i, 0) Set rs.Filtered = rs.OpenRecordset Do While (Not rsfiltered.EOF) myArray(i, 2) = myArray(i, 2) & vbNewLine _ & rsfiltered!ID & " - " _ & rsfiltered!RENEWALDATE rsfiltered.MoveNext Loop Debug.Print myArray(i, 0) Next i End If rs.Close Set rs = Nothing Set db = Nothing End Sub Private Sub PrintArray() On Error GoTo ErrorHandler Dim strCtlName As String Dim i As Integer For i = LBound(myArray) To UBound(myArray) strCtlName = "txt" & CStr(i + 1) Controls(strCtlName).Tag = i Controls(strCtlName) = "" Controls(strCtlName) = myArray(i, 2) Next i ExitSub: Exit Sub ErrorHandler: MsgBox "There has been an error. Please reload the form" Resume ExitSub End Sub
Another PM with code:
Code:Private Sub OpenContinuousForm(ctlName As String) On Error GoTo ErrorHandler Dim ctlValue As Integer Dim dayOfMonth As Long ctlValue = Controls(ctlName).Tag dayOfMonth = myArray(ctlValue, 0) DoCmd.OpenForm "Renewals", , , "[RenewalDate]=" & dayOfMonth, acFormEdit ExitSub: Exit Sub ErrorHandler: MsgBox "There has been an error. Please reload the form" Resume ExitSub End Sub Private Sub txt1_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt2_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt3_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt4_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt5_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt6_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt7_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt8_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt9_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt10_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt11_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt12_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt13_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt14_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt15_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt16_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt17_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt18_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt19_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt20_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt21_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt22_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt23_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt24_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt25_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt26_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt27_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt28_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt29_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt30_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt31_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt32_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub Private Sub txt33_Click() If Me.ActiveControl.Text <> "" Then OpenContinuousForm Me.ActiveControl.Name End If End Sub
Again, "it's not working" is vague. Do you get an error? If so, what is it and where does it occur? Do you get the wrong result? If so, what result are you getting and what did you expect?
Well, "Filtered" is not a method or data member of the recordset. Based on that line, I suspect you want "Filter". That said, I would probably open the next recordset on an SQL statement that used the array value.
And in the beginning build of the SQL statement, you need a space before FROM and a space before "UNION".
Using outlook is pretty simple. If you want to investigate that. Your call of course.
** I would probably open the next recordset on an SQL statement that used the array value.** Could you give me an example?
I need the calendar to be a part of the database so I wont be able to use outlook.
Set rs = db.OpenRecordset("SELECT...WHERE FieldName = " & YourArrayReferenceHere, dbOpenDynaset, dbSeeChanges)