Yearly calendar for attendance 11

[oxicottin]

Hello, I have been using excel for employee attendance and im sick of tabs ect. I have been looking for a MS access database that shows 12 months on a form and on the form your able to select a day and enter a attendence entry ect. Does anyone know of anything free out there Or a sample DB I can get started on? calendar stuff is quite confusing so I want to find a sample to start from.

Thanks!

Thanks,
SoggyCashew.....

 

[MajP]

In VBIDE
Tools, Options, General Tab, Error Trapping, "Break on Unhandled Errors"

You have it set up to break on all errors so your error trapping does absolutely nothing. It should never ever be set up like that, unless you are doing some type of debugging and want to identify the error number. Also on the first tab ensure you have "require variable declaration". This forces you to declare all variables. If not you can get unmanageable code.

Function EmailAsPDF() As String
'==================================================================================================
'//Code works with the macros so I can get a right click and choose to send .pdf by email
'==================================================================================================
    Dim strSubject As String
    Dim strMessageText As String
    Dim rptCur As String
    On Error GoTo errlbl
    rptCur = Screen.ActiveReport.Name

    strSubject = "Absence Report For " & Screen.ActiveReport.txtEmployeeName
    strMessageText = "Attached is a report for or between " & Screen.ActiveReport.txtYear & _
                   " for " & Screen.ActiveReport.txtEmployeeName & "."
    'vbNewLine & vbNewLine
    DoCmd.SendObject acSendReport, Screen.ActiveReport.Name, acFormatPDF, , , , strSubject, strMessageText, True
    'Close the report or form
    DoCmd.Close acReport, rptCur
    Exit Function
errlbl:
  '2501 is the cancel error
  If Err.Number <> 2501 Then
    MsgBox Err.Number & " " & Err.message & vbCrLf & " In EmailPDF"
  End If
  If CurrentProject.AllReports(rptCur).IsLoaded Then
      DoCmd.Close acReport, rptCur
  End If
End Function

 

[oxicottin]

Majp, I still get the error, also my copy in VBIDE- Tools/Options/General Tab/Error Trapping: Break on Unhandled Errors is checked but the require variable declaration wasnt so I check that and saved. I then replaced your code over mine and tried and I still get the same exaxt errors. In you texting did you uncheck Access Options/Current Database/Navagation: Display Navagation Pane? I have that unchecked and I am unable to exit the email but if I have that checked I can exit that email without these errors. Whats this have to do with the navagation pane?



Thanks,
SoggyCashew.....

 

[MajP]

So I googled this and there are lots of discussion of this, but did not see any solutions. Pretty much requires the exact same conditions you mentioned. If you make the report not "pop up" it will work. However, that is not a viable workaround because if the form is dialog then the report would end up behind it. You could do something like hit the report button, hide the form, open the report (not pop up), close the report, re show the form. This might not look as clean, but may be an option.

What happens is that an internal error is handled by access and it locks up before the error is trapped in code. The only solution which is pretty major is to bypass the docmd.sendobject and use automation of Outlook.

http://www.experts-exchange.com/Database/MS_Access/Q_24288626.html

 

[MajP]

I believe the problem may be with the macro for the shortcut menu not the vba code. From some of what I have read is that if a macro fails there is no way for it to release the connection. My guess is rebuild this shortcut menu without the use of macros.

This is one of the reasons I avoid the macros in Access because they don't release the object or the shell, the Macro processor keeps a thread locked to the process and then throws a tantrum when something stalls the process.

I tried this by going into the Macro and adding an OnError step. And you get the message here.

 

[oxicottin]

Majp, Ok I deleted/removed completly the macros and used the VBA below in each report to bring up a right click menu and I still get the same results/errors if I close the email even with error handling. The code uses access controls Policy ID numbers or calls the module like EmailAsPDF(). This was what I could find for a right click menu after Googeling.... Thoughts?

Private Sub Report_Load()
    CreateReportShortcutMenu 'Loads shortcut menu
End Sub

Private Sub CreateReportShortcutMenu()
'==================================================================================================
'//In the Report_Load Event enter CreateReportShortcutMenu then in the reports Property/Shortcut
'   Menu Bar enter the MenuName "vbaShortCutMenu"
'
' You must Reference to Microsoft Office xx.0 Object Library
'   Office 2003 - use 11.0
'   Office 2007 - use 12.0
'   Office 2010 - use 14.0
'   Office 2013 - use 15.0

' This Reference IS NOT the same as Microsoft Office 14.0 Access database engine Object Library
'==================================================================================================

    Dim MenuName As String
    Dim CB As CommandBar
    Dim CBB As CommandBarButton

    MenuName = "vbaShortCutMenu"

    On Error Resume Next
    Application.CommandBars(MenuName).Delete
    On Error GoTo 0

    'Create the menu
    Set CB = Application.CommandBars.Add(MenuName, msoBarPopup, False, False)

    'The following code creates the options for the menu
    Set CBB = CB.Controls.Add(msoControlButton, 15948, , , True)
    CBB.Caption = "Print..."

    Set CBB = CB.Controls.Add(msoControlButton, 7, , , True)
    CBB.Caption = "Zoom: 100%"

    Set CBB = CB.Controls.Add(msoControlButton, 12499, , , True)
    'Starts a new group.
    CBB.BeginGroup = True
    'Change the caption displayed for the control.
    CBB.Caption = "Save as PDF"

    Set CBB = CB.Controls.Add(msoControlButton, , , , True)
    CBB.Caption = "Send By E-mail..."
    CBB.Tag = "Send E-mail..."
    CBB.OnAction = "=EmailAsPDF()"  'Calls a module with Function EmailAsPDF()

    'Adds the Close command.
    Set CBB = CB.Controls.Add(msoControlButton, 923, , , True)
    'Starts a new group.
    CBB.BeginGroup = True
    'Change the caption displayed for the control.
    CBB.Caption = "Close Report"

    Set CB = Nothing
    Set CBB = Nothing

End Sub

Thanks,
SoggyCashew.....

 

[MajP]

I guess it disproves the theory that it is the macro not releasing.
So the other suggestion is to save the report and use automation instead of the docmd.sendobject. From what the poster says, it cured the problem. So the trick is to open the report, save it to disk, automate outlook, create email, and [optional] delete the report from disk.

So their basic code is

Set objOutlook = CreateObject("Outlook.Application")
            Set o = objOutlook.CreateItem(olMailItem)
            o.To = strTO
            o.Subject = "DCN Notice:   DCN " & strDCN 
            o.Body = "DCN " & strDCN & " has been submitted for review/assignment"
            o.Importance = olImportanceHigh  'High importance
           'here is where they first save the report to disk
           'See the code i provided with some additional features to save to a specified location
           'and kill the existing file.
            DoCmd.OutputTo acOutputReport, "rptReviewNotice", acFormatRTF, strLoc
            o.Attachments.Add strLoc, olByValue
            o.Display
            MsgBox "DCN " & strDCN & " has been submitted for review"
ErrSend:
    Select Case err.Number
   'error trap here
Exit Function

This code portion does not show how you make a full file name and path and if that file name exists how to delete it first. Also when you are done you may want the location of the file so you can kill it, or just leave it and kill it when you overwrite as shown below. So here is an example of opening a report, and saving it to disk. It also returns the full path if you want to kill it once done.

Public Function OpenReportAndSave(strReportName As String) As String
    'Create report and save as an attachment to the current record
    Dim myCurrentDir As String
    Dim myReportOutput As String
    Dim myMessage As String
    On Error GoTo ErrorHandler
    'In your case the report is already open so no need to open it.
    'DoCmd.OpenReport strReportName, acViewPreview
    myCurrentDir = CurrentProject.Path & "\"
    myReportOutput = myCurrentDir & strReportName & ".pdf"
    If Dir(myReportOutput) <> "" Then ' the file already exists--delete it first.
        VBA.SetAttr myReportOutput, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill myReportOutput ' delete the file.
        DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, myReportOutput, , , , acExportQualityPrint
     End If
        
    OpenReportAndSave = myReportOutput
    Exit Function
ErrorHandler:
    MsgBox Error$
End Function

 

[oxicottin]

Majp, is there a way I can just hide the Access shell or(application window) this way I can just keep the navigation pane open and be done, I remember I messed with this on a project for work because I hate the shell, I like it to look more like an application than a MS Access program. There is a lot of info out on this subject but in your option whats that best code for it?

Thanks,
SoggyCashew.....

 

[MajP]

I am not a big fan of hiding the application window. I have found too many problems doing that. Not very portable, there tends to be other issues. I would look at the approach of automating outlook. The below code does work. Basically show the nav window, send the email, then hide the nav window.

Function EmailAsPDF() As String
'==================================================================================================
'//Code works with the macros so I can get a right click and choose to send .pdf by email
'==================================================================================================
    Dim strSubject As String
    Dim strMessageText As String
    Dim rptCur As String
    On Error GoTo errlbl
    rptCur = Screen.ActiveReport.Name

    strSubject = "Absence Report For " & Screen.ActiveReport.txtEmployeeName
    strMessageText = "Attached is a report for or between " & Screen.ActiveReport.txtYear & _
                   " for " & Screen.ActiveReport.txtEmployeeName & "."
    'vbNewLine & vbNewLine
    ShowNavigationPane
    DoCmd.SendObject acSendReport, rptCur, acFormatPDF, , , , strSubject, strMessageText, True
    'Close the report or form
    DoCmd.Close acReport, rptCur
    HideNavigationPane
    Exit Function
errlbl:
  '2501 is the cancel error
  If Err.Number <> 2501 Then
    MsgBox "Error"
    'MsgBox Err.Number & " " & Err.message & vbCrLf & " In EmailPDF"
  Else
    MsgBox "Canceled"
  End If
  If CurrentProject.AllReports(rptCur).IsLoaded Then
      DoCmd.Close acReport, rptCur
  End If
  HideNavigationPane
End Function


Public Sub ShowNavigationPane()
  DoCmd.SelectObject acTable, , True
  DoCmd.Minimize
End Sub
Public Sub HideNavigationPane()
  DoCmd.SelectObject acTable, "Tbl_YearCalendar", True
  DoCmd.RunCommand acCmdWindowHide
End Sub

 

[oxicottin]

Majp, LOL I wish I read that before I did the whole DB with hiding the shell.... I got everything to work but I see what your saying, I ran into a lot of "I have to do it this way" in order to get it to work..... The example in your last post was what I had used when all this began and I think im going to go back with it and be done with this stupid email as pdf thing.... Yes it sucks seeing it on the side then not but Oh well....

Thanks,
SoggyCashew.....

 

[MajP]

Like I said the cleanest is to use Outlook automation. This works fine. Need to add a reference to Outlook

Public Function EmailAsPDFUsingAutomation()
    On Error GoTo Error_Handler
    Dim objOutlook As Outlook.Application
    Dim objEmail As Outlook.MailItem
    Dim strSubject As String
    Dim strMessageText As String
    Dim rptCur As Access.Report
    Dim AttachmentName As String
    Set rptCur = Screen.ActiveReport

    strSubject = "Absence Report For " & rptCur.txtEmployeeName
    strMessageText = "Attached is a report for or between " & rptCur.txtYear & _
                   " for " & rptCur.txtEmployeeName & "."
    Set objOutlook = CreateObject("Outlook.application")
    Set objEmail = objOutlook.CreateItem(olMailItem)
    AttachmentName = SaveOpenReportAsPDF(rptCur.Name)
    Debug.Print AttachmentName
    With objEmail
        '.To = strgTo
        .Subject = strSubject
        .Body = strMessageText
        .Attachments.Add AttachmentName
        .Display
    End With
    CloseAllReports
Exit_Here:
    Set objOutlook = Nothing
    Exit Function

Error_Handler:
    MsgBox Err & ": " & Err.Description
    CloseAllReports
    Resume Exit_Here
End Function

Public Function SaveOpenReportAsPDF(strReportName As String) As String
    'Create report and save as an attachment to the current record
    Dim myCurrentDir As String
    Dim myReportOutput As String
    Dim myMessage As String
  On Error GoTo ErrorHandler
    myCurrentDir = CurrentProject.Path & "\"
    myReportOutput = myCurrentDir & strReportName & ".pdf"
    If Dir(myReportOutput) <> "" Then ' the file already exists--delete it first.
        VBA.SetAttr myReportOutput, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill myReportOutput ' delete the file.
    End If
    DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, myReportOutput, , , , acExportQualityPrint
    SaveOpenReportAsPDF = myReportOutput
    Exit Function
ErrorHandler:
    MsgBox Error$
End Function

Public Sub CloseAllReports()
  Dim rpt As Access.Report
  For Each rpt In Application.Reports
    DoCmd.Close acReport, rpt.Name
  Next rpt
End Sub

 

[oxicottin]

Majp, your correct the Outlook automation worked with no troubles except the saved file in the curent directory isnt being deleted when the report closes so I created a public function DeleteOpenReportAsPDF and called it after:

With objEmail
        '.To = strgTo
        .Subject = strSubject
        .Body = strMessageText
        .Attachments.Add AttachmentName
        .Display
    End With
    [COLOR=#5C3566]Call DeleteOpenReportAsPDF 'Deletes the saved .pdf (NOTE: Report has to be popup and modal)[/color] 
   CloseAllReports 'Close
Exit_Here:
    Set objOutlook = Nothing
    Exit Function

But the thing is I had to make my reports modal/yes or I get an error 2476: You entered an expression that requires a report to be the active window. Unless you have anyother way to delete without making reports modal then this works.....

Public Function DeleteOpenReportAsPDF()
'==================================================================================================
'//Delete the saved .pdf (NOTE: Report has to be popup and modal)
'==================================================================================================

    Dim strReportName As String
    Dim myCurrentDir As String
    Dim myReportOutput As String
    
    strReportName = Screen.ActiveReport.Name
    
    myCurrentDir = CurrentProject.Path & "\"
    myReportOutput = myCurrentDir & strReportName & ".pdf"
    MsgBox myReportOutput
    If Dir(myReportOutput) <> "" Then ' the file already exists--delete it
        VBA.SetAttr myReportOutput, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill myReportOutput ' delete the file.
        End If
End Function

Thanks,
SoggyCashew.....

 

[MajP]

When you call the function savereportaspdf that function returns the full path and name tou your calling function. So you can just kill attachmentname in your emailattachmentaspdf function. If you want a stand alone function then pass in the the file name and path "attachmentname" since you have that information. You want to always avoid using active report,form,control whenever you can for this reason. The focus is no longer on a report therefore no active report.

 

[MajP]

Public Function DeleteSavedReport(FileName as string)
'==================================================================================================
'//Delete the saved .pdf, Filename is complete path and file name
'==================================================================================================
 'Add some error handling here 
 If Dir(FileName) <> "" Then ' the file already exists--delete it
        VBA.SetAttr FileName, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill FileName ' delete the file.
  End If
End Function

So from your main program you simply would call it like
DeleteSavedReport AttachmentName
And you can reuse this to delete any file.
However it could simply be one line of code in your main routine
vba.kill attachmentname

 

[oxicottin]

Majp, that worked perfectly.... Thanks!

Majp, I have another DB I have been using for 5 months now an I was just informed that its giving incorrect calculations due to hrsWorked. If you have time can you look at the posting I made in:

TEK-TIPS Microsoft: Access Queries And JET SQL


Thanks!

Thanks,
SoggyCashew.....

 

[jguesman14]

Love the database! How difficult would it be to change the week to begin with Sunday?

 

[MajP]

Extremely easy. The getOffset function takes in the first day of the week as an argument. If you see the code it is passed in vbSaturday, change that to vbSunday and change your labels.

 

[oxicottin]

Wow MajP your right that was easy...The (vbSaturday) is only found once in the modules:

mod_FillHolidays
mod_FillMonthLabels
mod_FillTextBoxes

And I replaced the weeks names to Sun - Sat in:

subFormMonth
rpt_YearViewCal

In all it took a whole 5 minutes.... I was woundering how this was done but I like the other way! Great question jgesman14.....

Thanks,
SoggyCashew.....

 

[jguesman14]

That worked perfectly! And so easy to do! Ok so now one final question that's probably going to be a little more in depth. Is there anyway that I can add a "week view" of everyone that is scheduled off for the week with the hours and amount of time they are scheduled off? Currently I use Outlooks week view in the calendar for a quick view but I am hoping to incorporate it in the database.

 

[MajP]

Sure, but that would take some definite work. The concepts are here, but you would need separate functions. Some ways it would be easy. Assume you pass a function a day 13 May 2014. Pretty easy to get first day of the week from that. Just move until you get sunday or use a little math using the dayofweek function. Then it would be easy to fill the remaining lables. You would fill it much the same way you fill the month view only using a different query.

 

[jguesman14]

I think that may be to advanced for me! LOL