Here is a scenario that plays out often in my experience:

Suppose you have a query that you would like to export to Excel, and let’s further suppose the query has, say, 150 columns.  You can use the CopyFromRecordset() function (https://msdn.microsoft.com/en-us/library/Aa165427(v=office.10).aspx  an awesome built-in function in Excel that takes your data and handily pastes it into a spreadsheet) but it does NOT paste the field names into the column headers, so the result is a table with no defined columns.  

You need a method of getting those column headers into the spreadsheet before you paste the data.  

It is a relatively simple matter to write a few lines of code to loop through the fields in the RecordSet and write those fields to the spreadsheet, and that will work just fine in most cases – but if it happens that your application performs this task on multiple different data sets?  Some applications I have developed have a variety of forms that the users want to be able to export to Excel so they can more easily sort and filter, delete, edit, etc. without affecting live data.  WriteFieldsToExcel() is a very simple reusable function that saves me the trouble of writing all that For…Each code every time.  

I have broken it down into two functions in my application to accommodate both ADO and DAO recordsets.  If you wish to have both, too, simply create a second function WriteFieldsToExcelADO() and reference the appropriate recordset type in the Declarations.

The function is super simple - it just loops through the field names in the recordset and writes them column by column as the loop variable i increases.  Enjoy, and happy coding!

' Writes field names from a given recordset to an Excel spreadsheet

Public Sub WriteFieldsToExcel(objXL As Object, rst As DAO.Recordset)

    Dim fld As DAO.Field

    Dim i As Long    

    For Each fld In rst.Fields

        objXL.Selection.Offset(0, i) = fld.Name

        i = i + 1

    Next fld    

End Sub

I’m not sure if it’s just me, or if it is a phenomenon common to Access programmers in general, but I find myself constantly exporting data to Excel, regardless of who the client might be.  I get hired to create a database so that they are not relying on clunky attempts at database emulation in Excel – yet when it’s all said and done, there is nearly always a justifiable requirement for an output to an Excel spreadsheet.

In the next few installments, I’ll show how I use some handy user-defined functions to easily place a button on just about ANY form with a RecordSource to export the form’s data to a nicely formatted Excel spreadsheet with only a couple of lines as demonstrated below (plus any required validation and/or standard error trap code you may want to include).

Set rst = Me.RecordsetClone

Call ExportRSCloneToExcel(rst)

The next few blogs will review the following functions:

• GetExcel() – covered in this blog

• WriteFieldsToExcel() – cycles through a recordset’s field list and adds it to a spreadsheet

• FormatReportGeneric() – does some basic, generic formatting of an Excel table

• ExportRSCloneToExcel() – see explanation above

It all starts with the GetExcel function, a simple function that allows me to create an Excel spreadsheet with a single line like the following:

Set objXL = GetExcel(FileName:=”C:\MyPath\MyFile.xlsx”,CreateNew:=True)

This simple line of code creates a new Excel object and adds a workbook to it.  If the optional CreateNew argument is False or omitted, the workbook named in the FileName argument is opened.  If the file doesn’t exist, it simply raises a 1004 error to the calling procedure.

I use this often to open Excel workbooks so that I can retrieve and edit data from them.  In this series, we’ll assume we are creating new workbooks in each instance, but the code would work equally as well with existing workbooks to which you want to add data.

Let’s begin with the GetExcel() function.  Note that you'll have to set a reference to the Microsoft Excel xx Object Library (xx being your installed version) under Tools==>References in your VBA Project window:

Function GetExcel(Optional FileName As String, Optional CreateNew As Boolean = False) As Object

    Dim objXL As Object    

    On Error GoTo errHandler

   ' Create an Excel Object

    Set objXL = CreateObject("Excel.Application")

    If FileName = "" Or CreateNew Then ' For new workbooks, add one to the collection

        objXL.Workbooks.Add

    Else ' For existing workbooks, open the one by the name you passed

        objXL.Workbooks.Open FileName

    End If

    Set GetExcel = objXL ' Return the new workbook

    Exit Function

errHandler:

    Err.Raise Err.Number ' Any issues get passed back up to the calling procedure

End Function

The next installment will review the WriteFieldsToExcel() function.  

Until then, happy coding!

I mentioned the FixQuotes function in the last blog, but it deserves a bit more focused attention.  The issue of quotes in text strings that ultimately get passed as variables to query strings is one that has caused much consternation in my experience. Since single quotes and double quotes can both appear in code for various reasons, the FixQuotes() function will get TWO doses of attention.  

SINGLE QUOTES IN TEXT STRINGS

For this first example, suppose you have a bit of code that constructs a WHERE clause based on a customer's last name:

strSQL = "SELECT * FROM tblCustomers WHERE LName = '" & me.txtLName & "'"

This snippet will work swimmingly as long as the customer's name isn't something like "O'Neil".  In such a case, the resultant SQL code that gets generated will have a critical flaw that will cause a syntax error:

SELECT * FROM tblCustomers WHERE LName = 'O' Neil'

The statement now tells the query engine to look for someone who's last name is "O" and then perform the "Neil" command.  Oh, and then open another quote, but don't close it.

The query engine responds with, "Wha...??"  or some similar "I can't do that, Dave" -type response.

The FixQuotes() function, used in conjunction with the Quote() function, attempts to mitigate such issues.   First, let's talk about the FixQuotes() function.

Function FixQuotes(strToFix As Variant, Optional DoubleQuote As Boolean = False) As String

    If DoubleQuote Then

        FixQuotes = Replace(Nz(strToFix), """", "'")

    Else

        FixQuotes = Replace(Nz(strToFix), "'", "''")

    End If

End Function

The FixQuotes() function simply escapes the single quote using two single quotes.  SQL sees the pair of single quotes (NOT the same as a single double-quote!!) as an actual single quote instead of the termination of a quote string.  We will address the optional DoubleQuotes argument in the next segment.

Function Quote(StringToQuote As Variant, Optional DoubleQuotes As Boolean = False) As String

    Quote = "'" & FixQuotes(StringToQuote, DoubleQuotes) & "'"

End Function

The Quote() function is just a handy programming keystroke saver that incorporates the FixQuotes() function to make it easier to wrap strings in quotes.  Thus:

FixQuotes("O'Neil") returns O''Neil and Quote("O'Neil") returns 'O''Neil'

For example, the following snippets show the graduating simplification of the code:

x = "O'Neil"

This one returns an error

strSQL = "SELECT * FROM tblCustomers WHERE LName = '" & x & "'" 

This one is OK, but a bit cumbersome:

strSQL = "SELECT * FROM tblCustomers WHERE LName = '" & FixQuotes(x) & "'"

Quote() wraps the string variable in quotes, fixing any quotes in the string

strSQL = "SELECT * FROM tblCustomers WHERE LName = " & Quote(x)

Adding these two functioins to your utility module will save you from SQL errors caused by spurrious quotes in your text strings plus simplify and streamline your code.  Look for Part 2 where we'll get into the double quote replacement aspect of these functions.

The previous post discussed how single quotes (like apostrophes) can confuse SQL code and cause syntax errors.  Single quote errors are perhaps more common (emphasis on "perhaps") but they do not hold an exclusive right to the Heartache and Discontent trophy. Double quotes appear in text strings, as well, and though the issues they cause are similar, they deserve separate attention.

DOUBLE QUOTES IN TEXT STRINGS

For this second example, suppose you have a bit of code that includes text from a Comments field.  Because single quotes are common, especially in comments where contractions (don't or isn't) and possessive nouns (Fred's or customer's) are used, you may choose to wrap such text strings in double quotes.  MS Access allows double quotes in SQL.  (SQL Server... not so much.)

strSQL = "SELECT * FROM tblCustomers WHERE Comments= " & """" & me.txtComments & """"

First of all, I typically create a public constant in my declarations module for the entire project that includes the following:

Const Q As String = """"

Thus I can rewrite my code this way:

strSQL = "SELECT * FROM tblCustomers WHERE LName = " & q & me.txtComments & q

Let's further suppose that the comment includes the following:

 The customer quoted Tom as being "a top-notch salesman"

Now we have a similar issue as in the last post.  The resultant SQL code has an early termination of the quote and then it has a few incorrect command words and then another opening quote without a closing quote.  We've got more errors than a little league game.

The FixQuotes() function, used in conjunction with the Quote() function, can help here, too.

The FixQuotes() function escapes the single double quote using four double quotes.  SQL sees the four double quotes as an actual double quote (again, NOT the same as two single quotes) instead of the termination of a quote string.  

Thus we can rewrite our code to look like this:

strSQL = "SELECT * FROM tblCustomers WHERE Comments = Quote(me.txtComments, true)

Note the inclusion of the optional boolean argument.   This tells Quote (and, in turn, FixQuotes) to replace double quotes instead of single quotes.  

I hope this helps!  Happy coding...

Fancy Message Box

How many times have you wished that Microsoft had not done away with the fancy formatted Message Box that we loved in Access 97?

I cannot count the times, myself.

Here is my solution - a replacement function that performs an Eval() on the classic MsgBox() function as a string expression. The Eval function then returns the formatted message box like we all love and miss (at least those of us who used it all the time).

The code is fairly simple. Taking a cue from a forum entry on the Microsoft Access Help Center, I created the function below that replaces the Prompt with appropriate code to create the formatted message.

A couple of important notes:

First, I used the tilde (~) instead of the at (@) sign because e-mail addresses are often included in my messages.  Substitute your favorite seldom-if-ever-used character if the tilde doesn't work for you.

Second, I have VERY often encountered issues with single quotes in string variables.  Apostrophes appear in contractions, Irish names, possessive nouns, and a variety of other situations that may end up as part of a text string that you want to put in quotes.  The Quote() function is a simple one-liner that references another short function called FixQuotes().  These two functions (also included below) ensure that quotes inside quotes don't confuse the issue and cause premature termination of quoted text because of a spurrious quote in the middle of your text string.

Happy coding!

' Replace MsgBox with a formatted version like the old-style messages

' The message box at the top used the following code:

' Msg_Box "Formatted message boxes were great!~Why did Microsoft get rid of them?", vbOKOnly Or vbExclamation, "FORMATTED MESSAGE BOX"

Function Msg_Box(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title As String = "Microsoft Access")

    Dim strPrompt As String
    Dim aPrompt As Variant

    ' If there is a delimiter, then replace the delimiter with the appropriate symbols
    ' otherwise, just send the prompt out as it is.

    If InStr(Prompt, "~") > 0 Then
        aPrompt = Split(Prompt, "~")
        strPrompt = aPrompt(0) & "@" & aPrompt(1) & "@@"
    Else
        strPrompt = Prompt
    End If
    ' Wrap the prompt and other parameters in an Eval to get the appropriate
    ' formatted output. The Quote function ensures that any apostrophes or
    ' other single-quotes are handled without crashing the output.

    Msg_Box = Eval("MsgBox(" & Quote(strPrompt) & "," & Buttons & "," & Quote(Title) & ")")

End Function

Function Quote(StringToQuote As Variant, Optional DoubleQuote As Boolean = False) As String

    Quote = "'" & FixQuotes(StringToQuote, DoubleQuote) & "'"

End Function

Function FixQuotes(strToFix As Variant, Optional DoubleQuote As Boolean = False) As String

    If DoubleQuote Then
        FixQuotes = Replace(Nz(strToFix), """", "'")
    Else
        FixQuotes = Replace(Nz(strToFix), "'", "''")
    End If

End Function