Access/VBA Library

GetColumnHistory

A wrapper around the VBA ColumnHistory function.

Syntax

GetColumnHistory( TableName, ColumnName, QueryString [, Ascending] )
Parameters
Name Type Description
TableName String Required. The name of the table.
ColumnName String Required. The name of the column of the table. This field should have the AppendOnly attribute set to true.
QueryString String Required. The String which locates the record within the table.
Ascending Boolean Optional. Indicates if the hirstoy data should be returned in ascending order.
Default: True
Return value

Collection : Collection of arrays containg the timestamp and the historical data.

Code
Public Function GetColumnHistory(TableName As String, ColumnName As String, QueryString As String, Optional ByVal Ascending As Boolean = True) As Collection
    
    Dim RegExpObject As Object
    Dim Matches As Object
    Dim Match As Object
    Dim StrHistoryData As String
    Dim HistoryData As New Collection
    Dim ForStart As Long
    Dim ForEnd As Long
    Dim ForStep As Long
    Dim idx As Long
    
    Set RegExpObject = CreateObject("VBScript.RegExp")
    With RegExpObject
        .Global = True
        ' Format : [Version: date time ] History data
        ' The word Version will differ according to the system language
        .Pattern = "[[].*:[ ]+(.* .*) []] (.*)"
        StrHistoryData = Application.ColumnHistory(TableName, ColumnName, QueryString)
        Set Matches = .Execute(StrHistoryData)
        
        If Matches.Count > 0 Then
            
            If Ascending Then
                ForStart = 0
                ForEnd = Matches.Count - 1
                ForStep = 1
            Else
                ForStart = Matches.Count - 1
                ForEnd = 0
                ForStep = -1
            End If
            
            For idx = ForStart To ForEnd Step ForStep
                Set Match = Matches.Item(idx)
                If idx = Matches.Count - 1 Then
                    HistoryData.Add Array(CDate(Match.SubMatches(0)), Match.SubMatches(1))
                Else
                    '
                    ' Somehow the linefeed character is removed from the end of the line.....
                    ' So, just skip the last character, though Access adds a vbCrLf to each line
                    '
                    HistoryData.Add Array(CDate(Match.SubMatches(0)), Left(Match.SubMatches(1), Len(Match.SubMatches(1)) - 1))
                End If
            Next idx
        End If
    End With
    
    Set RegExpObject = Nothing
    
    Set GetColumnHistory = HistoryData

End Function