[AccessD] Command to save the database
Bill Benson
bensonforums at gmail.com
Tue Jun 16 09:37:12 CDT 2015
ok, I still need some help - please.
I have been thwarted (temporarily I hope) by two conditions.
I put this code in a form that I want to open on startup. I am getting an
overflow error, I presume because the value in miliseconds is too high a
number. However, how else can I make the event occur only at 10 minute
intervals?
Secondly, when the database opens up, the AutoExec which calls my function
to open the frmSaveMe form invisibly runs PRIOR to the UI giving the option
to Enable content, and throws up a dialog in which the only response
appears to be "Stop All Macros". Kinda defeats the purpose of an AutoExec.
There is only one step in the macro, it is RunCode LaunchSaveMe().
How can I make this macro warning go away, and simply run - preferably
after Content has been enabled?
Private Sub Form_Load()
SaveMe
Me.TimerInterval = 1000 * 60 * 10
End Sub
Private Sub Form_Timer()
SaveMe
End Sub
'Standard module:
Sub SaveMe()
Dim objFSO As Object
Dim objFSOFolder As Object
Dim strThisApp As String
Dim iSpace As Long
Dim iNumeric As Long
Dim TheMax As Long
Dim strLookForNumeric As String
Dim FIL As Object
Dim strStartText As String
Dim strPath As String
strThisApp = Mid(CurrentDb.Name, InStrRev(CurrentDb.Name, "\") + 1)
strThisApp = Left(strThisApp, InStrRev(strThisApp, ".") - 1)
Set objFSO = New FileSystemObject
strPath = Environ("USERPROFILE") & "\My Documents"
On Error Resume Next
Set objFSOFolder = objFSO.GetFolder(strPath & "\Backups for " & strThisApp)
If objFSOFolder Is Nothing Then
Set objFSOFolder = objFSO.GetFolder(strPath & "\Backups for " &
strThisApp)
If objFSOFolder Is Nothing Then
Set objFSOFolder = objFSO.CreateFolder(strPath & "\Backups for " &
strThisApp)
End If
End If
For Each FIL In objFSOFolder.Files
If InStr(FIL.Name, "Backup No ") > 0 And InStr(FIL.Name, strThisApp) >
0 Then
strStartText = Mid(FIL.Name, Len("Backup No ") + 1)
iSpace = InStr(strStartText, Chr(32))
strLookForNumeric = Left(strStartText, iSpace - 1)
On Error Resume Next
iNumeric = CLng(strLookForNumeric)
If iNumeric > TheMax Then
TheMax = iNumeric
End If
End If
Next
objFSO.CopyFile CurrentDb.Name, objFSOFolder.Path & "\Backup No " &
Format(TheMax + 1, "0000") & " " & strThisApp & Mid(CurrentDb.Name,
InStrRev(CurrentDb.Name, "."))
RunCommand acCmdSave
End Sub
Function LaunchSaveMe()
On Error Resume Next
DoCmd.Close acForm, "FrmSaveMe", acSaveNo
DoCmd.OpenForm "frmsaveme", acNormal, , , , acHidden
End Function
More information about the AccessD
mailing list