UpRider said:
Dirk, could you elaborate on that a bit? I have a 'setup table' that
the user can edit to store his preferences and options. I found that
if I read the table at startup and stored the table contents in
variables, they could disappear. So I coded to read the table again
before each variable was used. It works fine, but is, of course,
inefficient. Your method sounds good to me, but the VBA documentation
on transferring values from a table to public class variables is a
bit dense. Can you help me get started here?
Okay. Here's the code I have in the basProfile module -- a standard
module -- in a small application. It happens to be an application that
manages a retail catalog and updates a database on the web:
'---------- start of module code -------------
Option Compare Database
Option Explicit
' Copyright © 2002, Dirk Goldgar
' Limited license granted: You may use this posted code freely, but not
' claim it as your own or sell it except as part of a larger
application.
Dim mfProfileLoaded As Boolean
Dim mstrClientName As String
Dim mstrLocalPictureFolder As String
Dim mstrWebPictureFolder As String
Dim mstrQuoteFolder As String
Dim mstrNoPictureFile As String
Dim mintRecentItemDays As Integer
Dim mstrWebDatabaseFolder As String
Dim mstrWebUpdateURL As String
Property Get ClientName() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
ClientName = mstrClientName
End Property
Property Get LocalPictureFolder() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
LocalPictureFolder = mstrLocalPictureFolder
End Property
Property Get QuoteFolder() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
QuoteFolder = mstrQuoteFolder
End Property
Public Function OpenProfileForm()
DoCmd.OpenForm "frmProfile"
End Function
Property Get WebPictureFolder() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
WebPictureFolder = mstrWebPictureFolder
End Property
Property Get WebDatabaseFolder() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
WebDatabaseFolder = mstrWebDatabaseFolder
End Property
Property Get WebUpdateURL() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
WebUpdateURL = mstrWebUpdateURL
End Property
Property Get NoPictureFile() As String
If mfProfileLoaded = False Then
LoadProfileData
End If
NoPictureFile = mstrNoPictureFile
End Property
Property Get RecentItemDays() As Integer
If mfProfileLoaded = False Then
LoadProfileData
End If
RecentItemDays = mintRecentItemDays
End Property
Public Sub LoadProfileData()
On Error GoTo Err_LoadProfileData
Dim rs As DAO.Recordset
Dim strFormat As String
Dim intStart As Integer
Dim intEnd As Integer
Set rs = CurrentDb.OpenRecordset("Profile")
With rs
mstrClientName = !ClientName & vbNullString
mstrLocalPictureFolder = !LocalPictureFolder & vbNullString
mstrWebPictureFolder = !WebPictureFolder & vbNullString
mstrNoPictureFile = !NoPictureFile & vbNullString
mintRecentItemDays = Nz(!RecentItemDays, 0)
mstrQuoteFolder = !QuoteFolder & vbNullString
mstrWebDatabaseFolder = !WebDatabaseFolder & vbNullString
mstrWebUpdateURL = !WebUpdateURL & vbNullString
.Close
End With
If Len(mstrLocalPictureFolder) = 0 Then
mstrLocalPictureFolder = CurrentProject.Path
End If
If Left(mstrLocalPictureFolder, 2) = ".\" Then
mstrLocalPictureFolder = _
CurrentProject.Path & Mid(mstrLocalPictureFolder, 2)
End If
If Len(mstrQuoteFolder) = 0 Then
mstrQuoteFolder = CurrentProject.Path
Else
' Process date-format specifications in the form "[fmtspec]".
Do
intStart = InStr(1, mstrQuoteFolder, "[", vbBinaryCompare)
If intStart > 0 Then
intEnd = InStr(intStart, mstrQuoteFolder, "]",
vbBinaryCompare)
If intEnd > intStart Then
strFormat = Mid$(mstrQuoteFolder, intStart + 1,
intEnd - (intStart + 1))
mstrQuoteFolder = _
Left$(mstrQuoteFolder, intStart - 1) & _
Format(Date, strFormat) & _
Mid$(mstrQuoteFolder, intEnd + 1)
End If
End If
Loop Until intStart = 0
' Insert application folder path if required.
If Left(mstrQuoteFolder, 2) = ".\" Then
mstrQuoteFolder = _
CurrentProject.Path & Mid(mstrQuoteFolder, 2)
End If
End If
mfProfileLoaded = True
Exit_LoadProfileData:
Set rs = Nothing
Exit Sub
Err_LoadProfileData:
MsgBox "ERROR - Unable to load profile data. " & _
"Either the database is damaged, or the Profile table " & _
"hasn't been filled in yet." & vbCr & vbCr & _
"The actual error was " & Err.Number & ": " &
Err.Description, _
vbExclamation, "Error Loading Profile"
Resume Exit_LoadProfileData
End Sub
'---------- end of module code -------------
The application also contains a form for maintaining the data in the
Profile table. In that form, there is a simple AfterUpdate event
procedure to ensure that the profile variables are reloaded when any
record is updated:
Private Sub Form_AfterUpdate()
LoadProfileData
End Sub
Does that clarify everything?
--
Dirk Goldgar, MS Access MVP
www.datagnostics.com
(please reply to the newsgroup)
