Per John:
>I design the front end of my app in MyAppName-develop.mdb. When I want to
deploy it I copy it and change the name to MyAppName.mdb. In the development
mdb I want a different start up option then in the mdb for the users: start
up with no database window but with the main menu form of my app. Is there a
way to prevent myself from having to change the start up settings manually
everytime I want to deploy my app. How do you guys do that?
I go a little further and call it myAppName.001.mdb... my
AppName.002.mdb... depending on it's version.
Set up an AutoExec macro that executes a routine written in VBA
that does stuff like this (starting around line 1070):
----------------------------------------------------
Function AutoExec() As Boolean
1000 debugStackPush mModuleName & ":AutoExec"
1001 On Error GoTo AutoExec_err
' PURPOSE: To perform any and all AutoExec processing
' NOTES: 1) Called by "AutoExec" macro
1003 Dim i As Long
Dim myFormName As String
Dim productionMode As Boolean
Dim myUserID As String
Dim myComputerName As String
Dim myLockMessage As String
Dim okToProceed As Boolean
Dim myAppTitle As String
Dim myWorkDbPath As String
Dim myHistoryUpdatedDate As Variant
Dim myDaysToAdd As Long
Dim myLastBackFillDate As Variant
Const appTitleProblem = "There was a problem in AutoExec
setting application title."
Const moveAfterEnter_DoNotMove = 0
'LogTime True, "AutoExec - Begin"
1006 myUserID = CurrentUserGet()
1007 myComputerName = ComputerNameGet()
1009 IniValue_Put myUserID, Format$(Now(), "yyyy-mm/dd-hh:nn"),
"Logged On"
1010 DoCmd.Hourglass True
'
--------------------------------------------------------------------------------------------
' We need to create all work tables before re-conecting them
because if a table does not
' exist, MS Access will not let us alter the connection string
1030 myWorkDbPath = WorkDbPath_Get()
1031 dataBaseDelete myWorkDbPath 'So the work db does not
get bigger-and-bigger day-after-day
1039 okToProceed = True
1040 If okToProceed = True Then
1041 okToProceed = False
1042 If ConnectRefresh() = True Then
'LogTime False, Space(3) & "ConnectRefresh"
1043 myAppTitle = IniValue_Get("ProgramParms", "TitleBar")
1044 If Len(myAppTitle) = 0 Then
1045 myAppTitle = appTitleProblem
1049 End If
1050 If applicationPropertySet("AppTitle", dbText,
myAppTitle) = True Then
1051 Application.RefreshTitleBar
1052 okToProceed = True
1053 Else
1054 BugAlert False, appTitleProblem
1059 MsgBox appTitleProblem, vbCritical, "Application
Cannot Be Run"
1060 End If
1061 okToProceed = True
1062 DoCmd.Hourglass True
1063 End If
1069 End If
' '
--------------------------------------------------------------------------------------------
' ' In part, want to carve out as much screen space as possible
- given that at least some
' ' people are running their monitors at 800x600
'
1070 If okToProceed = True Then
1071 okToProceed = False
1072 productionMode = ProductionMode_Get()
'
'1073 For i = 0 To Forms.Count - 1 'Subsitutes a
dummy menu bar
'1074 Forms(i).MenuBar = "mnuDummy"
'1075 Next i
''LogTime False, Space(3) & "Menu Bars dummied"
'
1076 DeveloperMenusToggle Not ProductionMode_Get()
''LogTime False, Space(3) & "DeveloperMenusToggle"
'
--------------------------------------------------------------------------------------------
' This keeps us from jumping from one control to another when
the user presses Enter.
' In the case of a ListBox, we want to capture Enter and call
DblClick processing.
1077 Application.SetOption "Move After Enter",
moveAfterEnter_DoNotMove
1078 okToProceed = True
'
--------------------------------------------------------------------------------------------
1079 End If
'
--------------------------------------------------------------------------------------------
' Ensure that each tranche has a payment record and a price
record for each day since
' a certain date
1090 StatusSet "Updating Payment/Price History Tables..."
1091 myHistoryUpdatedDate = IniValue_Get(gProgramParms,
"HistoryUpdatedDate")
1092 If IsDate(myHistoryUpdatedDate) Then
1093 myDaysToAdd = DateDiff("d", Date, myHistoryUpdatedDate)
1094 myDaysToAdd = Abs(myDaysToAdd)
1095 If myDaysToAdd <0 Then
1096 StatusSet "Updating Payment/Price History Tables..."
'1097 Payment_EmptyRecordsAppend_AllTranches
myHistoryUpdatedDate, myDaysToAdd
1098 PriceHistory_EmptyRecordsAppend_AllTranches
myHistoryUpdatedDate, myDaysToAdd
1099 IniValue_Put gProgramParms, "HistoryUpdatedDate", Date
1100 End If
1199 End If
'
--------------------------------------------------------------------------------------------
' Backfill tblGlobalMarketValue if necessary
1210 myLastBackFillDate = IniValue_Get(gProgramParms,
"LastBackFillDate")
1211 If IsDate(myLastBackFillDate) Then
1212 If DateDiff("d", Date, myLastBackFillDate) <0 Then
1214 GlobalMarketValues_BackFill False
1215 IniValue_Put gProgramParms, "LastBackFillDate", Date
'It's been done, but not today... so do it
1216 End If
1219 Else
1221 GlobalMarketValues_BackFill False 'It's never, ever been
done... so do it
1222 IniValue_Put gProgramParms, "LastBackFillDate", Date
1229 End If
'
--------------------------------------------------------------------------------------------
1310 If okToProceed = True Then
1311 okToProceed = False
1313 StatusSet ""
1314 MonthlyCheck_ReferenceRates
1315 MonthlyCheck_GlobalMarketValues
1316 DoCmd.OpenForm "frmHome"
1329 End If
'LogTime False, "AutoExec - End"
1990 DoCmd.Hourglass False
AutoExec_xit:
DebugStackPop
On Error Resume Next
Exit Function
AutoExec_err:
BugAlert True, ""
Resume AutoExec_xit
End Function
Private Function applicationPropertySet(ByVal thePropertyName As
String, ByVal thePropertyType As Variant, ByVal thePropertyValue
As Variant) As Integer
debugStackPush mModuleName & ": applicationPropertySet"
On Error GoTo applicationPropertySet_err
' PURPOSE: To set the named application property or, if it
doesn't exist, create it and then set it.
' ACCEPTS: - Name of the property
' - Type of the property
' - Value we want the property set to
' RETURNS: True or False depending on success
'
' NOTES: If this is used to set the AppTitle, the call to this
routine must be followed
' by an "Application.RefreshTitleBar" or you will not
see the new title until the
' app has been closed and then re-opened.
Dim myProperty As Property
Const propertyNotFound = 3270
curDB().Properties(thePropertyName) = thePropertyValue
applicationPropertySet = True
applicationPropertySet_xit:
DebugStackPop
On Error Resume Next
Exit Function
applicationPropertySet_err:
If Err = propertyNotFound Then
Set myProperty = curDB().CreateProperty(thePropertyName,
thePropertyType, thePropertyValue)
curDB().Properties.Append myProperty
Resume
Else
BugAlert True, "Property Name = '" & thePropertyName & "',
Type = '" & thePropertyType & "', Value = '" & thePropertyValue
& "'."
End If
End Function
----------------------------------------------------
--
PeteCresswell
