Celebrating 20 Years

Example VBA for MS-Access

MGT Computer Solutions >> Services >> Custom Programming >> BASIC >> VBA for MS-Access

This example function, written in VBA for Microsoft Access 2003 by MGT Computer Solutions, uses ADO to compare versions of different .mdb files as part of an automatic update management function.

Public Function GetVersion(Optional pStrApplicationFile As String) As String

' retrieves the Version attribute from the FrontEndAttributes table in a specified database
' defaults to the local database; a remote database may be specified in the parameter
' function has the SIDE EFFECT of setting global variable ApplicationVersion

  On Error GoTo GetVersionError

  ' accept parameter, apply default
  Dim strApplicationFile As String
  strApplicationFile = pStrApplicationFile
  If strApplicationFile = "" Then strApplicationFile = Application.CurrentDb().Name

  ' second request for the default value - trivial case
  If ApplicationVersion > "" And strApplicationFile = Application.CurrentDb().Name Then
    GetVersion = ApplicationVersion
    Exit Function
  End If

  ' first request for the default value - second-most trivial case
  If strApplicationFile = Application.CurrentDb().Name Then
    ApplicationVersion = DLookup("AttributeValue", "FrontEndAttributes", _
                                 "FrontEndAttributes.Attribute=""ApplicationVersion""")
    GetVersion = ApplicationVersion
    Exit Function
  End If

  ' version datum is in another data base - go get it
  Dim cADODBConn As ADODB.Connection
  Dim rstAttributes As ADODB.Recordset
  Dim strcADODBConn As String
  Dim strSQLAttributes As String
  Dim xDone As Boolean
  
  xDone = False
  
  ' Open connection
  strcADODBConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strApplicationFile
  Set cADODBConn = New ADODB.Connection
  cADODBConn.Open strcADODBConn
  
  ' Open Attribute table looking for the ApplicationVersion record
  Set rstAttributes = New ADODB.Recordset
  strSQLAttributes = "SELECT FrontEndAttributes.AttributeValue FROM FrontEndAttributes " & _
                     " WHERE Attribute = ""ApplicationVersion"";"
  rstAttributes.Open strSQLAttributes, cADODBConn, adOpenKeyset, adLockOptimistic, adCmdText

  ' Capture value
  GetVersion = rstAttributes!AttributeValue
  xDone = True
  
  ' clean up
  rstAttributes.Close
  cADODBConn.Close
  Set rstAttributes = Nothing
  Set cADODBConn = Nothing
  Exit Function
  
GetVersionError:
  ' clean up
  If Not rstAttributes Is Nothing Then
      If rstAttributes.state = adStateOpen Then rstAttributes.Close
  End If
  Set rstAttributes = Nothing
  
  If Not cADODBConn Is Nothing Then
      If cADODBConn.state = adStateOpen Then cADODBConn.Close
  End If
  Set cADODBConn = Nothing
  
  If Err.Number = 0 Then
  ElseIf Hex(Err.Number) = "80004005" Then  ' ignore these OLE DB jet errors in this case
  Else
    MsgBox Err.Source & " " & Err.Number & " " & Err.Description, , "Error"
  End If
  
  If Not xDone Then GetVersion = "0"

End Function

"The Miracle Workers of Computing" since 1989
Celebrating 20 Years

Any trademark appearing on this page is the property of its owner.