Results 1 to 13 of 13
  1. #1
    theajam is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Apr 2017
    Posts
    5

    Access Calendar


    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.

  2. #2
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    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.
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

  3. #3
    theajam is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Apr 2017
    Posts
    5
    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

  4. #4
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    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
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

  5. #5
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    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
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

  6. #6
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    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?
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

  7. #7
    theajam is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Apr 2017
    Posts
    5
    The calendar form should load and populate with the renewal dates but I am getting this error - Click image for larger version. 

Name:	error.JPG 
Views:	44 
Size:	157.9 KB 
ID:	28292

  8. #8
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    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.
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

  9. #9
    jwhite is offline Competent Performer
    Windows 10 Access 2013 32bit
    Join Date
    Dec 2012
    Location
    North Carolina
    Posts
    349
    And in the beginning build of the SQL statement, you need a space before FROM and a space before "UNION".

  10. #10
    Join Date
    Jun 2015
    Location
    Wales. Land of the sheep.
    Posts
    1,228
    Using outlook is pretty simple. If you want to investigate that. Your call of course.

  11. #11
    theajam is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Apr 2017
    Posts
    5
    ** I would probably open the next recordset on an SQL statement that used the array value.** Could you give me an example?

  12. #12
    theajam is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Apr 2017
    Posts
    5
    I need the calendar to be a part of the database so I wont be able to use outlook.

  13. #13
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    Set rs = db.OpenRecordset("SELECT...WHERE FieldName = " & YourArrayReferenceHere, dbOpenDynaset, dbSeeChanges)
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 4
    Last Post: 05-30-2016, 10:53 AM
  2. Calendar from Access
    By jlrehm in forum Access
    Replies: 3
    Last Post: 02-28-2015, 03:30 AM
  3. Access to Outlook Calendar
    By GregShah in forum Import/Export Data
    Replies: 1
    Last Post: 02-06-2012, 01:27 PM
  4. calendar on access
    By biagio in forum Access
    Replies: 1
    Last Post: 11-11-2011, 10:51 AM
  5. Access Calendar Control
    By JGG in forum Access
    Replies: 7
    Last Post: 04-03-2009, 04:34 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums