HALLAULIA!!!!!!!!!!
Do me one last favor on this 30-hour marathon. Scan the final
code to see if there's a "snake-in-grass" just waiting to bite me.
I COULD NOT HAVE DONE THIS WITHOUT YOU DOUG!!!
=========( Begin Final Code)================================
Option Compare Database
Option Explicit
Dim conBackend As ADODB.Connection
Dim errConnect As ADODB.Error
Dim strBackend As String
Dim rsInstProp As ADODB.Recordset
Dim strSQL As String
Public Sub LoadInstProp()
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
' Here and only here is where one sets the current version of the TMS
code.
' AND, where the compatibility version of the back-end database is set.
'
' The comparison at startup is to see if back-end is version compatible
with
' the front-end code. I.e., If the IPDBVersion found in the Installation
' Properties table is "Equal" to the TMSDBVersion to which the current
code
' is compatible.
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
TMSVersion = 7.2
TMSDBVersion = 7.1 'This ONLY changes when a TableDef changes.
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
strBackend = DLookup("InstDatabase", "InstProperties")
Set conBackend = New ADODB.Connection
conBackend.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= '" &
strBackend & "'"
Call InitVer7pt1 '7.1 is the 1st version of field upgradable
mdb's.
'==========================================================================
' This routine fetches the "Installation Properties" table and loads the
' corresponding global variables.
'==========================================================================
'Open the table containing the donation key.
strSQL = "SELECT * FROM [InstProperties]"
Set rsInstProp = New ADODB.Recordset
rsInstProp.Open strSQL, conBackend, adOpenKeyset, adLockOptimistic
If IsNull(rsInstProp!InstDBVersion) Then 'Null if we've just upgraded
rsInstProp!InstDBVersion = 7.1
If Len(IPAddress & "") > 0 Then
rsInstProp!InstAddress = IPAddress
Else
rsInstProp!InstAddress = "Please enter" 'User ignored prompt
End If
If Len(IPCityState & "") > 0 Then
rsInstProp!InstCityState = IPCityState
Else
rsInstProp!InstCityState = "Please enter" 'User ignored prompt
End If
rsInstProp.Update
End If
IPDBVersion = rsInstProp!InstDBVersion
IPName = rsInstProp!InstName
IPAcronym = rsInstProp!InstAcronym
IPPath = rsInstProp!InstPath
IPDatabase = rsInstProp!InstDatabase
IPImages = rsInstProp!InstImages
IPEmail = rsInstProp![InstE-mail]
IPAddress = rsInstProp!InstAddress
IPCityState = rsInstProp!InstCityState
IPPhone = rsInstProp!InstPhone
IPMDBRecip = rsInstProp![InstMDB-Recip]
IPRecipSubj = rsInstProp!InstRecipSubj
IPRecipMsg = rsInstProp!InstRecipMsg
'Close the properties table recordset.
rsInstProp.Close
Set rsInstProp = Nothing
Set conBackend = Nothing
If IPDBVersion < TMSDBVersion Then Call Upgrade
End Sub
Private Sub InitVer7pt1()
'==========================================================================
' TMS Version 7.1 is the first version of TMS where TableDef's are
upgraded
' in the field. If the current DB is found to be without the InstDBVersion
' field within the Installation Properties, then DB needs to be upgraded
to
' compatibility with at least version 7.1. THEN, after the Installation
' Properties are loaded in the main code (above), there will be checks to
' determine if further upgrades are required.
'==========================================================================
On Error GoTo Err_InitVer7pt1
Dim strDDL As String
Dim strErrors As String
Dim booNotFound As Boolean
Dim objFields As ADODB.Fields
Dim intIndex As Integer
booNotFound = True
strSQL = "SELECT * FROM [InstProperties]"
Set rsInstProp = New ADODB.Recordset
rsInstProp.Open strSQL, conBackend, adOpenKeyset, adLockOptimistic
Set objFields = rsInstProp.Fields
For intIndex = 0 To (objFields.Count - 1)
If objFields.Item(intIndex).Name = "InstDBVersion" Then booNotFound
= False
Next
'Release the lock. (Close the recordset)
rsInstProp.Close
Set rsInstProp = Nothing
If booNotFound = True Then
strDDL = "ALTER TABLE InstProperties ADD Column InstDBVersion
Single"
conBackend.Execute strDDL, dbFailOnError
strDDL = "ALTER TABLE InstProperties ADD Column InstAddress
text(50)"
conBackend.Execute strDDL, dbFailOnError
strDDL = "ALTER TABLE InstProperties ADD Column InstCityState
text(50)"
conBackend.Execute strDDL, dbFailOnError
IPAddress = InputBox("Your database has been updated to include two
new" & vbNewLine _
& "fields that are required for donation
statements" & vbNewLine _
& "suitable for submission to the IRS for tax
purposes." & vbNewLine & vbNewLine _
& "Please enter the mailing address of your
installation." & vbNewLine _
& "[We'll prompt for city, state and zip
momentarily.]")
IPCityState = InputBox("And now, the city, state zip of your
installation")
End If
'force Jet to finish any pending operations:
DBEngine.Idle dbRefreshCache
' Check whether any errors were returned
If conBackend.Errors.Count > 0 Then
If conBackend.Errors.Count = 1 Then
strErrors = "There is 1 error:" & vbCrLf
Else
strErrors = "There are " & _
conBackend.Errors.Count & _
" errors:" & vbCrLf
End If
For Each errConnect In conBackend.Errors
strErrors = strErrors & _
errConnect.Description & vbCrLf
Next errConnect
MsgBox strErrors
End If
End_InitVer7pt1:
Exit Sub
Err_InitVer7pt1:
MsgBox Err.Number & ": " & Err.Description
Resume End_InitVer7pt1
End Sub
Private Sub Upgrade()
MsgBox "Database at version " & IPDBVersion & "TMS requires it be at " &
TMSDBVersion
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
' New code is required here to perform necessary upgrades from known
versions.
' That means when TMS code requires an update to any TableDefs that code
be
' inserted here to accomplish the modifications. For example, say we
update
' TMS to version 8.3 and that version requires TableDef changes. We set
' TMSDBVersion to 8.3 and write the necessary code to modify the table
definitions
' accordingly and update the IPDBVersion of the database to match.
'
' Everytime such a change is necessary we iterate the code blocks until
we've
' taken the current back-end database incrementally to the highest level,
where
' each block takes us from one version to the next and so on.
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
End Sub
=========(End Final Code)=============================
Douglas J. Steele said:
You need to instantiate an instance pointing to the actual database that
contains the tables.
Dim dbCurr As DAO.Database
dbCurr = OpenDatabase("C:\Folder\MyBackend.MDB")
dbCurr.Execute "DDL", dbFailOnError
dbCurr.Close
Set dbCurr = Nothing
