Access/VBA Library


A wrapper around the VBA ColumnHistory function.


GetColumnHistory( TableName, ColumnName, QueryString [, Ascending] )
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.

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
                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))
                    ' 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