Access MVP (2010-2015)

oOo.oOo.oOo.oOo.oOo.oOo

eMailing specific Reports to specific Recipients…

Question: Can anyone tell me how to eMail a report with content based data based on the individual?

Answer:
Create a Module, name it anything you like except the name of the Function.

At the top of your Module under…

Option Compare Database
Option Explicit

…place

Public olApp As Object
Public olNameSpace As Object
Public objRecipients As Object
Public objNewMail As Object 'Outlook.MailItem

Then, we need something to initialize Outlook, so, copy/paste the below into the same Module…

Function InitializeOutlook() As Boolean
' This function is used to initialize the global Application and
' NameSpace variables.
    
    On Error GoTo Init_Err
    Set olApp = CreateObject("Outlook.Application", "LocalHost")  ' Application object
    Set olNameSpace = olApp.GetNamespace("MAPI")  ' Namespace object
    Set objNewMail = olApp.CreateItem(0)
    InitializeOutlook = True
Init_Bye:
    
    Exit Function
Init_Err:
    InitializeOutlook = False
    Resume Init_Bye
    
End Function

And now we can copy/paste the Function into the same Module…
Note: After you have copied it you will need to change the Paths, Query, Report and Field Names to match your own.

Function streMailOverdue() As String
On Error GoTo Error_Proc
‘From: http://regina-whipp.com/blog/ 
    
    DoCmd.Hourglass True
    
    'Set global Application and NameSpace object variables, if necessary.
    If olApp Is Nothing Then
        If InitializeOutlook = False Then
            MsgBox "Unable to initialize Microsoft Outlook!"
        End If
    End If
    
    'Create new MailItem object.
    Set objNewMail = olApp.CreateItem(0)
    
    Dim strTo As String
    Dim strSQL As String
    Dim rs As Recordset
    Dim strSubject As String
    Dim strBody As String
    Dim strAttachment As String
    
    'Get the eMails for those who are to receive a Report
    strSQL = "SELECT apAssociateID, apeMailAddress " & _
                "FROM qryeMailAddresses"

    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    'Save Report outside Access
    With rs
        .MoveFirst
            Do While Not .EOF
                DoCmd.OutputTo acOutputReport, "rpteMailReport", acFormatPDF, "\\SERVERNAME\data\eMailReports\" & !apAssociateID & "-ToDoListFor_" & Format(Date, "mm.dd.yyyy") & ".pdf"
                strAttachment = "\\SERVERNAME\data\eMailReports\" & !apAssociateID & "-ToDoListFor_" & Format(Date, "mm.dd.yyyy") & ".pdf"
            'Send eMail and Report
            Set objNewMail = olApp.CreateItem(0)
            With objNewMail
                .To = rs.Fields("apeMailAddress")
                .Subject = "To Do List Items Overdue!"
                .Body = "See attachment..."
                    If strAttachment <> "" Then
                        .Attachments.Add strAttachment
                    End If
                .Send
            End With
        .MoveNext
        Loop
            'Delete the Reports
            If Dir("\\SERVERNAME\data\eMailReports\*.pdf") <> "" Then
                Kill "\\SERVERNAME\data\eMailReports\*.pdf"
            End If
        End With
        
        rs.Close
        Set rs = Nothing
    
Exit_Proc:
    DoCmd.Hourglass False
    Exit Function
Error_Proc:
    Select Case Err.Number
        Case 287:
          'On Error Resume Next
          Resume Exit_Proc 'ignore the error'
        Case Else:
          MsgBox "Error encountered streMailOverdue: " & Err.Description
          Resume Exit_Proc 'display a message then exit'
    End Select

End Function

Now, on your Form in the Event Procedure of your Command Button place…

Call eMailOverdue

All done!

25 total views, 4 views today

Windows 10 my 2 cents worth…

I have been *playing* with Windows 10 for about a month and half now.  Since then I have removed the ability to upgrade any other machine to Windows 10.  Says a lot right?  However, my reasons for not wanting to upgrade the other machines is not because there was any problem with the in-place upgrade, hardware conflicts or any other issues others are seeing.  So why?

1.

I have older programs that run on Windows 7 64 bit but will not run on Windows 10 64 bit.  Not sure why but having tried to load a few of them and trying to get them to run was good enough for me.  This is a HUGE issue as I use those programs frequently enough that I would need two machines running and then be transferring files back and forth, no sense in that.

Third party drivers that have not been upgraded will cause major, crippling issues.  Am I supposed to replace all my equipment, really?

To boot, there is no Windows 10 Upgrade Tool to tell which programs/hardware are incompatible, nope, it just uninstalls it or breaks your machine, really?

2.

Having a machine update on its own is disturbing.  We all have come to know *Patch Tuesday* as a *Let me see what’s broken now Tuesday*.  Spending the day trying to figure out which update did what causes me serious downtime.  And then to add to my stress… waiting another week (or more) for a fix is beyond crazy.  Should one just hang out a shingle… *Business closed due to Windows updates, will reopen when fixed!*, really?

3.

Installation of Office 2016 Click-to-Run, in some cases, removes Office 2013.  Umm, as a developer that supports ALL versions of Office, this is a huge inconvenience.  I either need a virtual machine or I have to switch to the .MSI installation or I’m back to two machines running.  Even two machines is an issue, what if I go to a Client that has both?  What then?

 

4.

Widgets – I have family and clients all over the world.  Calling them can be challenging with all the different Time Zones, so… on my Windows 7 Desktop sits clocks for each location of my family, no can do in Windows 10 with buying a bunch of different clocks.  Really?

On the same note, I kept the weather widget, just for fun so I can also see the weather where they are, so again… really?

5.

Cortana – I do not want some artificial *intelligence* peeking at my Contacts or my eMails.  I do not want it remembering where I searched.  On that same note, this should not be an hour exercise to turn off.  Really?

6.

Mail tile that shows me an envelope with a number, really?  You can get a live feed from Twitter (when it’s working) but you can’t get a live feed for my incoming mail.  Really?

7.

Flip 3D gone.  Loved that and made it so much easier when, if you’re like me, you 10+ windows open.  It was in my top 5 reasons for moving to Windows 7.  Now, I’m back to using my keyboard, really?

8.

Flat Icons – Feel like we went back to the 1980’s or is the 1990’s, really?

9.

Renaming of Programs on Program Apps menu and I still can’t figure out how to move them around, I don’t want them in ALPHA order and I don’t want Tiles.  There is a system my madness and now doing what I do requires extra clicks.  On that same note, what happened to right mouse click > Send To Desktop?  I want my Shortcuts on my Desktop.  I have about 30 of them there now and I use them.  To do that in Windows 7 one has to navigate to the actual file, really?

10.

Edge – Why?  Just tell me why because I hate it, quickly installed Internet Explorer.

While I understand the issues that go with supporting multiple versions of anything, whether it be Windows or Office and that Microsoft may not want to do it but there are those of us that still do it.  It’s our business.  So for Office, a choice should be an option as it was in previous versions of Office.  For Windows 10, at a minimum, let us choose whether we want without having to jump thru hoops to say no and let us choose whether we want to install updates/patches automatically or not.  Again, all which was available in previous versions of Office and Windows.

Just in case you’re interested, my opinion of Windows 10…
Slick UI  (Yep, that’s it!)

If you have not upgraded yet and still want to, a few things I would suggest…
Confirm your hardware is compatible – That little icon that says your machine is ready is not quite accurate.  Do your own research by either visiting the manufacturer’s website or going to the Microsoft Forums and searching.

Visit…
Windows 10 Specifications
Known issues with Office and Windows 10

Do the same for your software, especially if it’s older software.  The fact that it runs on Windows 7 64 bit or 32 bit is not a prerequisite for it running on Windows 10.  This has been especially problematic for Anti-Virus software.

If you’re on a metered connection be careful, see…
http://lifehacker.com/enable-metered-connection-to-delay-windows-10-updates-1723316525

However, this won’t help for the initial download.  You will need to figure out a plan yourself to get it initially installed.

Connection speed – I have a relatively fast connection, 100 mbps, so my download and install was done in less than an hour.  Bare that in mind when getting ready to download and install.

After it installs the password I did have set was no longer valid.  Instead I say my eMail and that is the password it wanted, ugh.  I did change it that which does not affect your password to your eMail but some warning would have been nice as that is not the eMail I would have chosen.  (I guess I don’t understand why it couldn’t leave my previously supplied password.)

If you don’t…
Third party tool (most effective)
GWX Control Panel app

OR…

Manual
This is what I did to stop the nagging and the attempts to download…

Uninstall these updates (found in the Microsoft Windows section):

KB2952664
KB2976978 (usually found on Windows 8.x machines)
KB2990214
KB3021917
KB3035583
KB3044374 (usually found on Windows 8.x machines)
KB3068708

Do NOT reboot when it asks you.  After you are done go to Windows Update and search for updates, and you will see them listed again. Right mouse click on each one individually and select Hide update.  Then go to Windows Update under Control Panel and select Change Settings and uncheck Give me recommended updates the same way I receive important updates.  I have also changed my Important Updates to Check for updates but let me choose whether to download and install them.

Side note: While those updates come in as Optional and Important, once installed they are shown as Recommended.

12 total views, no views today

Export a Parameter Query to Excel…

It’s always tricky when you want export filtered data to Excel.  You will get an error message if you put try to put the Forms Control in the Criteria section of the Query.  Why?  Because Access insists on having the value before it can execute the export and not from the Form but directly in its SQL.  So, we will create the Query *on the fly*, export and then delete it, after all, no need to keep it as it will be recreated with new parameters for the next export.  Let’s get started…

Create your Template (Line 17) and make note of which row you want your Recordset (data) to start on (Line 30), as well as, cells that you want to populate in the header part of your spreadsheet, such as, the date (Line 26).  Then you will need the path of your Template and the path and naming convention of the saved worksheet (Line 43).

Copy/paste the Function SendToExcel into a Module… that said I usually put it behind the Filter Form because I am using a Template specific to a Recordset and I can use the same name for the Function and when I put the button on the Form I can keep that code the same, which a few minor changes.

Function SendToExcel(strTQName As String, strSheetName As String)
'Modified from http://btabdevelopment.com/export-a-table-or-query-to-excel-to-specific-worksheet/
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

        Dim rst As DAO.Recordset
        Dim ApXL As Object
        Dim xlWBk As Object
        Dim xlWSh As Object
        Dim fld As DAO.Field
        Dim lngMaxRow As Long
        Dim lngMaxCol As Long
        Dim strPath As String

        On Error GoTo Err_Handler
            'Full Path and Name of Template
            strPath = "Full Path and Name of Template"

            Set rst = CurrentDb.OpenRecordset(strTQName)
            Set ApXL = CreateObject("Excel.Application")

            Set xlWBk = ApXL.Workbooks.Open(strPath)
            ApXL.Visible = True

            'Set xlWSh = xlWBk.Worksheets(strSheetName)
            'xlWSh.Range("A1").Value = Date

            rst.MoveFirst
           'The first row that you want your data to appear on
            xlWSh.Range("A5").CopyFromRecordset rst
            'Selects the first cell to unselect all cells
            xlWSh.Range("A5").Select
        'To apply Filters and to automatically resize the columns
        xlWSh.Activate
        xlWSh.Cells.Rows(4).AutoFilter
        xlWSh.Cells.Rows(4).EntireColumn.AutoFit

        rst.Close
        Set rst = Nothing
        'Remove prompts to save the Spreadsheet
        ApXL.DisplayAlerts = False
        'You will want to rename the Template so as to not overwrite it
        xlWBk.SaveAs "Full Path and Name of NEW Workbook", 51
        ApXL.DisplayAlerts = True
        'ApXL.Quit

        Exit Function
Err_Handler:
        DoCmd.SetWarnings True
        MsgBox Err.Description, vbExclamation, Err.Number
        Exit Function

End Function

Put a Command Button on your Form.  Now, we need to determine what type of Query you have, is it…

Straight SQL

strSQL = "SELECT... " & _
         "FROM..."

SQL with a Group By 

strSQL = "SELECT... " & _
         "FROM... " & _
         "GROUP BY..."

SQL with Criteria (WHERE) separate from what will be selected on the Form

strSQL = "SELECT... " & _
         "FROM... " & _
         "WHERE... " & _
         "ORDER BY..."

Not sure?  Go to Design View of the Query and then select SQL View (upper left hand corner).  Once you got which one scroll down to the appropriate section.

Then copy/paste the below between the Private Sub and End Sub.  You will need to modify the filtering portion to match the name of the Controls and your Recordsource accordingly.  Once done you can begin testing and adjusting.

Straight SQL

'Code from Allen Browne’s site (http://allenbrowne.com/ser-62code.html) modified

        Dim dbs As DAO.Database
        Dim qryDef As DAO.QueryDef
        Dim strSQL As String
        Dim strWhere As String
        Dim lngLen As Long
        Dim lngWhere As String

        Set dbs = CurrentDb

    'Put the SQL portion only of your Query here.
    strSQL = "SELECT…”

    'Text field example. Use quotes around the value in the string.
    If Not IsNull(Me.txtFilterCity) Then
        strWhere = strWhere & "([City] = """ & Me.txtFilterCity & """) AND "
    End If

    'Another text field example. Use Like to find anywhere in the field.
    If Not IsNull(Me.txtFilterMainName) Then
        strWhere = strWhere & "([MainName] Like ""*" & Me.txtFilterMainName & "*"") AND "
    End If

    'Number field example. Do not add the extra quotes.
    If Not IsNull(Me.cboFilterLevel) Then
        strWhere = strWhere & "([LevelID] = " & Me.cboFilterLevel & ") AND "
    End If

    'Yes/No field and combo example. If combo is blank or contains "ALL", we do nothing.
    If Me.cboFilterIsCorporate = True Then
        strWhere = strWhere & "([IsCorporate] = True) AND "
    ElseIf Me.cboFilterIsCorporate = 0 Then
        strWhere = strWhere & "([IsCorporate] = False) AND "
    End If

    'Date field example. Use the format string to add the # delimiters and get the right international format.
    If Not IsNull(Me.txtStartDate) Then
        strWhere = strWhere & "([EnteredOn] >= " & Format(Me.txtStartDate, conJetDate) & ") AND "
    End If

    'Another date field example. Use "less than the next day" since this field has times as well as dates.
    If Not IsNull(Me.txtEndDate) Then   'Less than the next day.
        strWhere = strWhere & "([EnteredOn] < " & Format(Me.txtEndDate + 1, conJetDate) & ") AND "
    End If

'I added an example for multi-select List Boxes
        If Me.lstRoleID.ItemsSelected.Count <> 0 Then
            'add selected values to string
            Set ctl = Me.lstRoleID
            For Each varItem In ctl.ItemsSelected
              'strWhere = strWhere & ctl.ItemData(varItem) & ","
              'Use this line if your value is text
              lngWhere = lngWhere & "'" & ctl.ItemData(varItem) & "',"
            Next varItem
            'trim trailing comma
            lngWhere = Left(lngWhere, Len(lngWhere) - 1)
            strWhere = strWhere & "stSourceType IN(" & lngWhere & ") AND "
        End If

    lngLen = Len(strWhere) - 5

    If lngLen <= 0 Then
        'If no selection is made then send everything to Excel
        strSQL = strSQL
        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)
        'DoCmd.OpenQuery qryDef.Name
        qryDef.Close
        Set qryDef = Nothing
        DoEvents
        Call SendToExcel("qrySendToExcel", "Sheet1")
        DoEvents
        DoCmd.DeleteObject acQuery, "qrySendToExcel"
    Else
        'Send filtered results to Excel
        strWhere = Left$(strWhere, lngLen)
        strSQL = strSQL & " WHERE " & strWhere
        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)
        'DoCmd.OpenQuery qryDef.Name
        qryDef.Close
        Set qryDef = Nothing
        DoEvents
        Call SendToExcel("qrySendToExcel", "Sheet1")
        DoEvents
        DoCmd.DeleteObject acQuery, "qrySendToExcel"
    End If

        dbs.Close
        Set dbs = Nothing

SQL with a Group By  *You will need to add the filtering from Straight SQL

        Dim dbs As DAO.Database
        Dim qryDef As DAO.QueryDef
        Dim strSQL As String
        Dim strWhere As String
        Dim strOrderBy As String
        Dim lngLen As Long
        Dim lngWhere As String

        Set dbs = CurrentDb

    'Put the SQL portion only of your Query here.
    strSQL = "SELECT…”

    strOrderBy = " ORDER BY quniMIForExcel.mySequence"

'ADD FILTERING FROM Straight SQL and adjust

    lngLen = Len(strWhere) - 5

    If lngLen <= 0 Then
        'If no selection is made then send everything to Excel
        strSQL = strSQL & strOrderBy
        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)
        'DoCmd.OpenQuery qryDef.Name
        qryDef.Close
        Set qryDef = Nothing
        DoEvents
        Call SendToExcel("qrySendToExcel", "Sheet1")
        DoEvents
        DoCmd.DeleteObject acQuery, "qrySendToExcel"
    Else
        'Send filtered results to Excel
        strWhere = Left$(strWhere, lngLen)
        strSQL = strSQL & " WHERE " & strWhere & strOrderBy
        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)
        'DoCmd.OpenQuery qryDef.Name
        qryDef.Close
        Set qryDef = Nothing
        DoEvents
        Call SendToExcel("qrySendToExcel ", "Sheet1")
        DoEvents
        DoCmd.DeleteObject acQuery, "qrySendToExcel"
    End If

        dbs.Close
        Set dbs = Nothing

SQL with Criteria separate from what will be selected on the Form  *You will need to add the filtering from Straight SQL

        Dim dbs As DAO.Database
        Dim qryDef As DAO.QueryDef
        Dim strSQL As String
        Dim strWhere As String
        Dim strQueryWhere As String
        Dim strOrderBy As String
        Dim lngLen As Long
        Dim lngWhere As String

        Set dbs = CurrentDb

    'Put the SQL portion only of your Query here.
    strSQL = "SELECT…”

    strOrderBy = " ORDER BY quniMIForExcel.mySequence"
    strQueryWhere = "(((tblLifts.lStatusID)=1 Or (tblLifts.lStatusID)=0) AND ((tblLifts.lTransferTo) Is Null) AND ((tblCoilRun.crNoShow)=False))"

'ADD FILTERING FROM Straight SQL and adjust

    lngLen = Len(strWhere) - 5

    If lngLen <= 0 Then
        'If no selection is made then send everything to Excel
        strSQL = strSQL & " WHERE " & strQueryWhere & strOrderBy
        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)
        'DoCmd.OpenQuery qryDef.Name
        qryDef.Close
        Set qryDef = Nothing
        DoEvents
        Call SendToExcel("qrySendToExcel", "Sheet1")
        DoEvents
        DoCmd.DeleteObject acQuery, "qrySendToExcel"
    Else
        'Send filtered results to Excel
        strWhere = Left$(strWhere, lngLen)
        strSQL = strSQL & " WHERE " & strQueryWhere & " AND " & strWhere & strOrderBy
        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)
        'DoCmd.OpenQuery qryDef.Name
        qryDef.Close
        Set qryDef = Nothing
        DoEvents
        Call SendToExcel("qrySendToExcel", "Sheet1")
        DoEvents
        DoCmd.DeleteObject acQuery, "qrySendToExcel"
    End If

        dbs.Close
        Set dbs = Nothing

Don’t forget to add error code!

11 total views, no views today

Call Me…

Calling an Event Procedure from one Form to another…

Every once in a while I need to use the same code I have in the Event Procedure of a one Control in another Forms Event Procedure, whether it be the On_Click event of a Command Button or the After_Update of a Combo Box.  99% of the time I would just turn that into in Function or a Sub and drop it into a Module and done, I can now reuse it over and over with no issues.  So why would I or anyone need to do this?  Simple… the Users makes an update on a Subform and I need to refresh the Main Form and that code is specific to the Controls on that Form/Subform, what easier way than to just reuse the code already available in an Event Procedure in another Form.  (This happens about 1% of the time, if not less.  It is not something I would recommend to do regularly.)  Now, I could just copy/paste it to the Subform but if I ever have to make a change I have to remember to hit both places!  Leaving it where it is makes sense, now, I just need to change it in one place.

So now, the specifics…

First and foremost, you must either remove the Private from in front of the Sub and/or change it to Public but it’s not necessary.  I tend to change it to Public, only because if I need to find it I can use Find > Public Sub as a parameter finding it quickly.  (Using Find > Sub will cause me to stop at every Event in every Module!)

Example…
Was Private Sub cboSearch_AfterUpdate changed to Public Sub cboSearch_AfterUpdate()

And the difference between Public Sub and Private Sub?  Ken Sheridan explains it best…

Declaring a function in a standard module Public exposes it throughout the database, so it can be called from queries, forms, code in other modules, etc.  Declaring a function in a standard module Private exposes it only within the module, so should be done where a function is called by another function or procedure in the same module, but not by anything outside the module.   The same name can be used for Private functions in different modules, but a Public function’s name must be distinct within the whole database.

From: Private or Pubic Functions?

Then you will need to make sure the Form that you are referencing is open.  That said, you can open it minimized or hidden but it must be open or you cannot access the Public Function.

From Subform (Child) to Main Form (Parent)
Function or Sub

Call Forms.frmYourForm.pubYourPublicFunction

OR…

Call Forms("frmYourForm").pubYourPublicFunction

Combo Box

Call Forms("frmYourForm").cmdYourComboBox_AfterUpdate

OR…

Me.Parent.cmdYourComboBox_AfterUpdate

Command Button

Forms("frmYourForm").cmdYourCommandButton_Click

OR…

Me.Parent.cmdYourCommandButton_Click

 

From Main Form (Parent) to Subform (Child) Form
Function or Sub

Me.sfrYourSubform.Form.pubYourPublicFunction

Combo Box

Me.sfrYourSubform.Form.cmdYourComboBox_AfterUpdate

Command Button

Me.sfrYourSubform.Form.cmdYourCommanButton_Click

 

From another Control on the same Form (Parent or Child)
Function or Sub (The same way you would call a normal Module)

Call pubYourPublicFunction

Combo Box

Call cboYourComboBox_AfterUpdate

Command Box

Call cmdYourCommanButton_Click

 

From Subform (Child) to Main Form (Parent) of Main Form (Parent) Form
Function or Sub

Me.Parent.Parent.pubYourPublicFunction

Combo Box

Me.Parent.Parent.cmdYourComboBox_AfterUpdate

Command Button

Me.Parent.Parent.cmdYourCommandButton_Click

 

From a Public Module to Subform (Child) via Main Form (Parent)
Function or Sub

Forms("frmMain")("sfrYourSubform").pubYourPublicFunction

Combo Box

Forms("frmMain")("sfrYourSubform").cmdYourComboBox_AfterUpdate

Command Button

Forms("frmMain")("sfrYourSubform").cmdYourCommandButton_Click

28 total views, 1 views today

Controlling Scrollbars in Subforms…

Subforms are a little peculiar when used as Continuous Forms… when the Subform produces 3 records which, in this example, calls for the Scrollbar and you then switch, from the Main Form, and you only have two records or less showing you have this shadow area where the Scrollbar used to be (Figure2)… slightly annoying and not very nice looking on your Form.

To avoid this put the below in the On_Current event of the Subform…

Note: In this example the Subform is sized to allow three records to show.  If you have adjusted to show more (or less) records then adjust the RecordCount accordingly.

If Me.RecordsetClone.RecordCount > 1 Then
   Me.ScrollBars = 2
Else
   Me.ScrollBars = 0
End If

Form.ScrollBars Property

Setting Visual Basic Description
Neither (forms) None (text boxes) 0 (Default for text boxes) No scroll bars appear on the form or text box.
Horizontal Only (forms) 1 Horizontal scroll bar appears on the form. Not applicable to text boxes.
Vertical Only (forms) Vertical (text boxes) 2 Vertical scroll bar appears on the form or text box.
Both (forms) 3 (Default for forms) Vertical and horizontal scroll bars appear on the form. Not applicable to text boxes.

From: https://msdn.microsoft.com/en-us/library/office/ff834790.aspx?f=255&MSPPError=-2147217396

(Though the page says Office 2013 or later this property has been available since Access 97, so, feel free to use in earlier versions of Access.)

249 total views, 8 views today