Using Excel Templates to Create Formatted Worksheets Filled with Access Data

If you want to produce a more formatted worksheet, you can prepare an Excel template and format it as needed — for example, adding a large, centered title and column headings with appropriate text, perhaps in a larger or bolder font than the data area. Then, instead of using the Excel command on the Ribbon, use VBA code to export the Access data row by row to the data area of a new worksheet created from the template. I created a set of queries for archiving data, again using the sample Northwind data, and a dialog form (fdlgArchiveOrders) that allows the user to select a date range for archiving Orders data, as shown in Figure 3.5.

. >jrr Note the calendar icon next to the date controls (it appears when a control bound to a Date field has the focus). Clicking the icon opens a calendar for selecting a valid date, as shown in Figure 3.6. The new calendar pop-up is definitely useful, though selecting a date far in the past can be tedious, because there is no way to move year by year.

A dialog form for selecting Northwind Orders data to archive.

A dialog form for selecting Northwind Orders data to archive.

Selecting a date from the calendar pop-up.

Once the start date and end date have been entered or selected, clicking the Archive button runs a procedure that creates a new Excel worksheet from a template (Orders Archive.xltx) in the same folder as the database, fills it with data from tblOrders in the selected date range, and deletes the archived records.

The ArchiveData procedure uses the Start Date and End Date values selected in the dialog as arguments. This procedure is listed as follows, together with the CreateAndTestQuery procedure it uses to create a query programmatically, and another procedure (TestFileExists) that tests whether a file exists in a specific folder:

Public Sub ArchiveData(dteStart As Date, dteEnd As Date)

On Error GoTo ErrorHandler

Dim appExcel As Excel.Application Dim intReturn As Integer Dim lngCount As Long Dim n As Long

Dim rng As Excel.Range

Dim rngStart As Excel.Range

Dim strDBPath As String

Dim strPrompt As String

Dim strQuery As String

Dim strSaveName As String

Dim strSheet As String

Dim strSheetTitle As String

Dim strSQL As String

Dim strTemplate As String

Dim strTemplateFile As String

Dim strTemplatePath As String

Dim strTitle As String

Dim wkb As Excel.Workbook

Dim wks As Excel.Worksheet

Create a filtered query using the dates selected in the dialog:

strQuery = "qryArchive" Set dbs = CurrentDb strSQL = "SELECT * FROM tblOrders WHERE " _

& "[ShippedDate] Between #" & dteStart & "# And #" _ & dteEnd & "#;" Debug.Print "SQL for " & strQuery & ": " & strSQL lngCount = CreateAndTestQuery(strQuery, strSQL) Debug.Print "No. of items found: " & lngCount If lngCount = 0 Then

Exit if no orders are found in the selected date range:

strPrompt = "No orders found for this date range; "

& "canceling archiving" strTitle = "Canceling"

MsgBox strPrompt, vbOKOnly + vbCritical, strTitle GoTo ErrorHandlerExit Else strPrompt = lngCount & " orders found in this date "

& "range; archive them?" strTitle = "Archiving"

intReturn = MsgBox(strPrompt, vbYesNo + vbQuestion, strTitle) If intReturn = vbNo Then GoTo ErrorHandlerExit End If End If

Create a new worksheet from the template and export the Access data to it:

strDBPath = Application.CurrentProject.Path & Debug.Print "Current database path: " & strDBPath strTemplate = "Orders Archive.xltx" strTemplateFile = strDBPath & strTemplate If TestFileExists(strTemplateFile) = False Then

Put up a message and exit if the template is not found:

strTitle = "Template not found"

strPrompt = "Excel template 'Orders Archive.xlt'" _ & " not found in " & strDBPath & ";" & vbCrLf _ & "please put template in this folder and try again" MsgBox strPrompt, vbCritical + vbOKOnly, strTitle GoTo ErrorHandlerExit Else

Debug.Print "Excel template used: " & strTemplateFile End If

Template found; create a new worksheet from it:

Set appExcel = GetObject(, "Excel.Application") Set rst = dbs.OpenRecordset("qryRecordsToArchive") Set wkb = appExcel.Workbooks.Add(strTemplateFile) Set wks = wkb.Sheets(i) wks.Activate appExcel.Visible = True

Write the date range to title cell:

strSheetTitle = "Archived Orders for " _ & Format(dteStart, "d-mmm-yyyy") _ & " to " & Format(dteEnd, "d-mmm-yyyy") Debug.Print "Sheet title: " & strSheetTitle rng.Value = strSheetTitle

Go to the first data cell:

Set rngStart = wks.Range("A4") Set rng = wks.Range("A4")

Reset lngCount to the number of records in the data source query:

rst.MoveLast rst.MoveFirst lngCount = rst.RecordCount

For n = 1 To lngCount

Write data from the recordset to the data area of the worksheet, using the columnoffset argument to move to the next cell:

rng.

.Value

= Nz(rst![OrderID])

Set

rng =

rng.Offset(columnoffset:

:=1

rng.

Value

= Nz(rst![Customer])

Set

rng =

rng.Offset(columnoffset:

:=1

rng.

Value

= Nz(rst![Employee])

Set

rng =

rng.Offset(columnoffset:

; =1

rng.

Value

= Nz(rst![OrderDate])

Set

rng =

rng.Offset(columnoffset:

; =1

rng.

Value

= Nz(rst![RequiredDate])

Set

rng =

rng.Offset(columnoffset:

; =1

rng.

Value

= Nz(rst![ShippedDate])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![Shipper])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![Freight])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![ShipName])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![ShipAddress])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![ShipCity])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![ShipRegion])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![ShipPostalCode])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![ShipCountry])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![Product])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![UnitPrice])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![Quantity])

Set

rng =

rng.Offset(columnoffset:

=1

rng.

Value

= Nz(rst![Discount])

Go to the next row in the worksheet, using the rowoffset argument: rst.MoveNext

Set rng = rngStart.Offset(rowoffset:=n) Next n

Save and close the filled-in worksheet, using a workbook save name with the date range selected in the dialog:

strSaveName = strDBPath & strSheetTitle & ".xlsx" Debug.Print "Time sheet save name: " & strSaveName

ChDir strDBPath

On Error Resume Next If there already is a saved worksheet with this name, delete it: Kill strSaveName

On Error GoTo ErrorHandler wkb.SaveAs FileName:=strSaveName, _

FileFormat:=xlWorkbookDefault wkb.Close rst.Close

Put up a success message, listing the name and path of the new worksheet: strTitle = "Workbook created"

strPrompt = "Archive workbook '" & strSheetTitle & "'" _

& vbCrLf & "created in " & strDBPath MsgBox strPrompt, vbOKOnly + vblnformation, strTitle

Delete the archived records, processing the "many" table first, because you can't delete a record in the "one" table if there are linked records in the "many" table:

DoCmd.SetWarnings False strSQL = "DELETE tblOrderDetails.*, " _ & "tblOrders.ShippedDate " _

& "FROM tblOrderDetails INNER JOIN qryArchive " _ & "ON tblOrderDetails.OrderlD = qryArchive.OrderlD;" Debug.Print "SQL string: " & strSQL DoCmd.RunSQL strSQL

strSQL = "DELETE tblOrders.* FROM tblOrders WHERE " _ & "[ShippedDate] Between #" & dteStart & "# And #" _ & dteEnd & "#;" Debug.Print "SQL string: " & strSQL DoCmd.RunSQL strSQL

Put up a message listing the cleared records:

strTitle = "Records cleared" strPrompt = "Archived records from " _ & Format(dteStart, "d-mmm-yyyy") _ & " to " & Format(dteEnd, "d-mmm-yyyy") _ & " cleared from tables" MsgBox strPrompt, vbOKOnly + vblnformation, strTitle

ErrorHandlerExit: Exit Sub

ErrorHandler:

'Excel is not running; open Excel with CreateObject If Err.Number = 42 9 Then

Set appExcel = CreateObject("Excel.Application") Resume Next Else

MsgBox "Error No: " & Err.Number & "; Description: " Resume ErrorHandlerExit End If

End Sub

Public Function CreateAndTestQuery(strTestQuery As String, _ strTestSQL As String) As Long

This function is called from other procedures to create a filtered query, using a SQL string in its strTestSQL argument:

On Error Resume Next

Dim qdf As DAO.QueryDef

'Delete old query Set dbs = CurrentDb dbs.QueryDefs.Delete strTestQuery

On Error GoTo ErrorHandler

'Create new query

Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)

'Test whether there are any records Set rst = dbs.OpenRecordset(strTestQuery) With rst

.MoveFirst .MoveLast

CreateAndTestQuery = .RecordCount End With

ErrorHandlerExit: Exit Function

ErrorHandler:

If Err.Number = 3 021 Then CreateAndTestQuery = 0 Resume ErrorHandlerExit Else

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit End If

End Function

Public Function TestFileExists(strFile As String) As Boolean On Error Resume Next

TestFileExists = Not (Dir(strFile) = "") End Function j : - p The code in the sample database requires a reference to the Excel object library;

|Wfc 3frJ.rtXiShjS Figure 3.7 shows this reference checked in the References dialog, which is opened from the Tools menu in the Visual Basic window.

FIGURE 3.7

Setting a reference to the Excel object model.

References - Access to Word

Available References:

Microsoft Excel 200 7 Obiect Library

□ Microsoft Fax Service Extended COM Type Library

□ Microsoft Fax Service Extended COM Type Library

□ Microsoft Feeds, version 1,0

□ Microsoft Graph 12.0 Object Library

□ Microsoft Help Data Services 1.0 Type Library

□ Microsoft HTML Object Library

□ Microsoft IMAPI2 Base Functionality

□ Microsoft IMAPI2 Rle System Image Creator

□ Microsoft InfoPath 2.0 Type Library

□ Microsoft Information Card IE Helper 1,0 Type Librar LJ Microsoft InkDivider Type Library, version L 5

□ Microsoft InkEdit Control 1,0

i 1 Microsoft Ipt anrl Renliratinn nhiprti 7.6 I ihrarv .. ^ — . :_

Priority

Microsoft Excel 2007 Object Library

Location: JiVrogram RlesWicrosoft Office\Offfcei2^XCEL,EXE Language: Standard

After the worksheet of archived records has been created and saved, you will get a message (depicted in Figure 3.8) listing the location where the archive worksheet was saved.

FIGURE 3.8

A success message after records are archived.

FIGURE 3.8

j ^ j TSJ' J^*^^ See Chapter 7 for a more flexible way of specifying a Templates folder and a Documents

After the code deletes the archived records — first the ones in tblOrderDetails (the "many" table) and then those in tblOrders (the "one" table) — a final message appears, as shown in Figure 3.9.

FIGURE 3.9

A final informative message stating that the archived database records have been cleared.

FIGURE 3.9

A worksheet filled with archived data is shown in Figure 3.10.

FIGURE 3.10

A worksheet filled with archived Access data.

FIGURE 3.10

A worksheet filled with archived Access data.

Saving the newly created worksheet with the xlWorkbookDefault value for the FileFormat argument saves it as a standard Excel worksheet. If you need to save the worksheet in another format, perhaps for use by someone running an older version of Excel, you can use one of the other values in the XlFileFormat enum, which are shown in the Object Browser in Figure 3.11. The xlExcel9795 named constant will create a worksheet in a format usable by people running Excel 95 or 97. (The worksheet format choices available in VBA code are much more numerous than those available in the interface, as shown in Figure 3.12.)

Viewing the file format choices for saving an Excel workbook.

Viewing the file format choices for saving an Excel workbook.

If you create a worksheet in the new .xlsx format, only Office 2007 users will be able fciiK^jadfagia»- to open it. To create a worksheet that can be opened and edited by users with earlier versions of Office, select one of the other formats. The Excel 97-Excel 2003 Workbook (.xls) format (shown being selected in Figure 3.12) is usable in Office 97 through 2007, so it is generally the most useful worksheet format.

FIGURE 3.12

Selecting a worksheet save format.

FIGURE 3.12

Selecting a worksheet save format.

i : ' IF)" r ^°Pen the Object Browser for examining components of an object model, open the visual Basic window and select Object Browser from the View menu, or press F2.

0 0

Post a comment