Friday, October 12, 2007

Generic function to copy Excel data between Workbooks

I needed way to ensure that some Excel workbooks that were being completed by customers and uploaded to a server for analysis and subsequent loading into a database, were not being tampered with. Certainly in Excel version up to and including 2003 it is not possible to prevent a determined user from "cracking" the Worksheet and Workbook protection passwords and hence to modifying any formulae in the Workbook.

My solution was to create a new, clean copy of the workbook from a master template and to then copy the customer entered data from the submitted book to the new clean book. The following CopyExcelData sub does the bulk of the work - the comments explain what is going on.

It does take some time to do this as it operates cell-by-cell (around 1 minute to copy 500 cells spread across 15 worksheets) but its not a bad trade-off to be safe in the knowledge that the final result is tamper-proof.

As a side benefit, any corrections needed to the customer workbook after it has been issued can be made to the template version and files received after that point will be automatically "upgraded".

Public Sub CopyExcelData( _
ByRef wkbSource As Object, _
ByRef wkbTarget As Object, _
Optional ByVal blnCopyEmptyCells As Boolean = True)

'*** Change to remove control chars as it crashes Excel 97 ***'

' Copy all data entry cells from one workbook
' to the other assuming that a data entry cell
' is:
' 1) On Visible sheets only
' 2) In the UsedRange of cells
' 3) If Sheet is Protected then Unlocked Cells
' 4) If Sheet is UnProtected then Non-formula cells
'
' Since the target is expected to be the 'good' copy,
' that is the one we use to test the above conditions
' and we then extract the corresponding data from the
' source cell and place it in the target cell

' Note: late binding has been used to limit any issues
' related to different versions of Excel, parameters
' are actually:
' ByRef wkbSource As Excel.Workbook
' ByRef wkbTarget As Excel.Workbook


Dim appExcel As Object 'Excel.Application
Dim blnProtectTarget As Boolean
Dim rngAllTarget As Object 'Excel.Range
Dim rngCellSource As Object 'Excel.Range
Dim rngCellTarget As Object 'Excel.Range
Dim wksSource As Object 'Excel.Worksheet
Dim wksTarget As Object 'Excel.Worksheet
Dim xlCalcMode As Variant


' Before we start, ensure calculation mode is manual
Set appExcel = wkbSource.Application
xlCalcMode = appExcel.Calculation
appExcel.Calculation = xlCalculationManual

For Each wksTarget In wkbTarget.Worksheets
If wksTarget.Visible = xlSheetVisible Then
' We only want data on sheets the user can see
' so we ignore any that are Hidden or VeryHidden
Set rngAllTarget = wksTarget.UsedRange
If Not rngAllTarget Is Nothing Then
' We have some non-empty cells on this sheet
Set wksSource = wkbSource.Worksheets(wksTarget.Name)
blnProtectTarget = wksTarget.ProtectContents
For Each rngCellTarget In rngAllTarget.Cells
' Stepping through each cell in the range...
With rngCellTarget
If (blnProtectTarget And Not .Locked) Or _
(Not blnProtectTarget And Not .HasFormula) Then
' This is a cell that can be completed in
' the original target sheet so examine further
If .Address = .MergeArea(1, 1).Address Then
' This is the main cell for a merged set of cells
' or not merged at all so we are interested...
Set rngCellSource = wksSource.Range(.Address)
If Not IsError(rngCellSource.Value2) Then
' Only copy valid cell entries
If rngCellSource.HasFormula And _
Not (rngCellSource.FormulaHidden Or .FormulaHidden) Then
' They are using a formula and we can access the formula
' in both source and target so transfer it (can't access this
' property if FormulaHidden is TRUE for either)
.Formula = rngCellSource.Formula
ElseIf Len(rngCellSource.Value2) > 0 Or blnCopyEmptyCells Then
' Not a formula so just get the value using Value2
' to avoid problems introduced by incorrect date formats
' NOTE: remove control characters to avoid Excel 97 crash
.Value2 = tcStripChars(rngCellSource.Value2, scmcRemoveControl)
End If
End If
End If
End If
End With
Next rngCellTarget
End If
End If
Next wksTarget

' Return calculation mode to whatever it was before
appExcel.Calculation = xlCalcMode

Set rngCellTarget = Nothing
Set rngCellSource = Nothing
Set wksSource = Nothing
Set wksTarget = Nothing
Set appExcel = Nothing
End Sub


Public Function GetNamedRangeValue(ByRef nm As Object) As Variant

' To get the value held by a range name. This
' function handles Named constants and formulae
' which can't be evaluated by the object itself

' Note: to avoid problems with different Excel
' versions, we use late binding of the range
' and the input parameter:
' ByRef nm As Excel.Name
' Dim rng As Excel.Range


Dim rng As Object ' Excel.Range

With nm
' Check to see if this is a named constant or formula
' in which case it won't have a range object
On Error Resume Next
Set rng = .RefersToRange
On Error GoTo 0
If rng Is Nothing Then
' This a named constant or named formula
' so we need to use Excel to evaluate
On Error Resume Next
GetNamedRangeValue = .Application.ExecuteExcel4Macro(Mid(.RefersToR1C1, 2))
On Error GoTo 0
Else
' This is a cell so we can recover the value
' using the RefersToRange value2 which allows
' us better control over formatting glitches
GetNamedRangeValue = .RefersToRange.Value2
End If
End With
Set rng = Nothing
End Function

Thursday, March 01, 2007

How to tell if an Access Report was Printed

I needed to be able to determine if an Access Report had been actually sent to the printer (as opposed to just previewed on screen) so that I could update a log recording the fact. This is useful for tracking whether or not a letter has been sent to a customer without requiring the user to click on a separate "log" button.

After some research on the 'net I discovered that a lot of the published solutions only half-solved the problem. Microsoft themselves got it completely wrong in this knowledgebase article!

The trick is understanding the different events that are fired when an Access report is opened. Supposing the ReportHeader section is visible, its Print event will be fired when the report is generated in Preview mode and again every time the report is sent to the printer. To guard against the situation where the report is sent direct to the printer without first being opened in preview, we also need to look at the Activate event which will be fired when the report is opened in preview mode. Because the Activate event also fires whenever we switch back the preview from another window, we also need to track the Deactivate event to know that we have switched away from the preview.

And so that I don't have to add code to every report that I want to track for all these events, I will define a class that sinks the events in the report's open events as follows:

ReportPrintStatus class definition

' Use the hidden object type for a section so we can sink the events
' (thanks to Stephen Lebans for this tip - see www.lebans.com)

Private WithEvents mrpt As Access.Report
Private WithEvents msecReportHeader As Access.[_SectionInReport]
Private mintCounter As Integer

'--------------------------------
' Public Properties and Methods
'--------------------------------

Public Property Set Report(rpt As Access.Report)
' Sink the event handling for this report
Const strEventKey As String = "[Event Procedure]"
Set mrpt = rpt
With mrpt
' If we don't populate these properties, the events will
' never fire in the report and we will be sunk!
.OnActivate = strEventKey
.OnClose = strEventKey
.OnDeactivate = strEventKey
' Note, we assume this section exists - if not, it won't work
Set msecReportHeader = .Section(acHeader)
msecReportHeader.OnPrint = strEventKey
End With
End Property

Public Property Get Printed() As Boolean
' Did they print this report?
Printed = (mintCounter >= 1)
End Property

Public Sub Term()
' If we don't destroy these objects here, we risk an Access GPF!
On Error Resume Next
Set msecReportHeader = Nothing
Set mrpt = Nothing
End Sub

'--------------------------------
' Event Procedures
'--------------------------------

Private Sub mrpt_Activate()
' This occurs if we open the report in print preview and also when
' we switch back to the previewed report in which case incremented
' by deactivate event
mintCounter = mintCounter - 1
End Sub

Private Sub mrpt_Close()
' This occurs when the report closes so ensure we destroy objects
' to prevent an Access GPF
Me.Term
End Sub

Private Sub mrpt_Deactivate()
' Called when we close report from preview or if we switch out of
' preview mode to another window in which case decremented by
' associated activate event
mintCounter = mintCounter + 1
End Sub

Private Sub msecReportHeader_Print(Cancel As Integer, PrintCount As Integer)
' Increment our counter occurs once for every time we print and also
' the first time we open in preview mode
mintCounter = mintCounter + 1
End Sub

Now it becomes a simple matter to have a report work out if it was printed or just previewed by inserting the following lines in the report's code module. Note that this was in Access 97 - in later versions I could raise a ReportPrinted event.

Private rps As ReportPrintStatus

Private Sub Report_Close()
If rps.Printed Then
' Do something
End If
End Sub

Private Sub Report_Open(Cancel As Integer)
' Sink the reports events so we can determine if it was printed or not
Set rps = New ReportPrintStatus
Set rps.Report = Me
End Sub