wiklendt
i recommend chocolate
- Local time
- Today, 18:13
- Joined
- Mar 10, 2008
- Messages
- 1,746
Hi all, long time no see.
I have cobbled together a Side-end (SE) which is triggered by Front-end (FE) to Compact/Repair (C/R) the Back-end (BE) in an automated way when users are not connected.
Basically, I have the SE "wait" for the FE to do its own C/R on close, and I've chosen a very safe 10sec, before checking for BE .ldb. What I would like to do is to better utilise that 10sec by checking for the .ldb at the same time but only up to 10s - rather than check for .ldb after the 10s has passed.
I figure to put this in a loop of some sort and to exit the loop if one of two criteria are met:
- the .ldb file is not present. (in which case will then continue to then C/R BE)
- the maximum of 10s is reached. (in which case will then quit SE).
existing code that I have is the two separately and was thinking i'd need to somehow put them together in a clever way. unfortunately i'm not very clever myself! Assistance/advice appreciated.
Wait code:
.ldb check code (Pause function usage highlighted for clarity):
I have cobbled together a Side-end (SE) which is triggered by Front-end (FE) to Compact/Repair (C/R) the Back-end (BE) in an automated way when users are not connected.
Basically, I have the SE "wait" for the FE to do its own C/R on close, and I've chosen a very safe 10sec, before checking for BE .ldb. What I would like to do is to better utilise that 10sec by checking for the .ldb at the same time but only up to 10s - rather than check for .ldb after the 10s has passed.
I figure to put this in a loop of some sort and to exit the loop if one of two criteria are met:
- the .ldb file is not present. (in which case will then continue to then C/R BE)
- the maximum of 10s is reached. (in which case will then quit SE).
existing code that I have is the two separately and was thinking i'd need to somehow put them together in a clever way. unfortunately i'm not very clever myself! Assistance/advice appreciated.
Wait code:
Code:
Public Function Pause(NumberOfSeconds As Variant)
[COLOR="SeaGreen"]'---------------------------------------------------------------------------------------
' Procedure : Pause
' Author : DACrosby (?)
' Date : 07/08/2017
' Purpose : Call this function to pause the application
' From : https://stackoverflow.com/questions/6960434/timing-delays-in-vba
'---------------------------------------------------------------------------------------
'
[/COLOR]On Error GoTo Error_GoTo
Dim PauseTime As Variant
Dim Start As Variant
Dim Elapsed As Variant
PauseTime = NumberOfSeconds
Start = Timer
Elapsed = 0
Do While Timer < Start + PauseTime
Elapsed = Elapsed + 1
If Timer = 0 Then
' Crossing midnight
PauseTime = PauseTime - Elapsed
Start = 0
Elapsed = 0
End If
DoEvents
Loop
Exit_GoTo:
On Error GoTo 0
Exit Function
Error_GoTo:
Debug.Print Err.Number, Err.Description, Erl
GoTo Exit_GoTo
End Function.ldb check code (Pause function usage highlighted for clarity):
Code:
Function Compact_DB()
[COLOR="seagreen"]'---------------------------------------------------------------------------------------
' Module : modCRdatabase
' Author : original written by ? from "CompactRepair.mdb"
' Modified : Agnieszka Wiklendt
' Date : 07/08/2017
' Called by : The "on unload" event of login form in FE calls this file only after
' ensuring that Compact/Repair (C/R) is required (an interval determined by
' a text file writen on the last C/R event).
' Purpose : This code checks that the BE is not locked with a .ldb file, then:
' Copies a system file to prevent new users to open/lock the BE
' C/Rs the BE to a temporary file
' Deletes original BE and renames temp file to real file name for BE
' Writes new date to 'system text file' so FE can determine when to next C/R
'---------------------------------------------------------------------------------------
[/COLOR]On Error GoTo Err_Compact_DB
Dim strMasterPath As String
Dim strDeveloperTestPath As String
Dim strLiveServerPath As String
Dim strBEpath As String
Dim strBEfile As String
Dim strLDBfile As String
Dim strLOCKfile As String
Dim objFileSystem As Object [COLOR="SeaGreen"]'Initiates FileSystem Object
[/COLOR]
Set objFileSystem = CreateObject("Scripting.FileSystemObject") [COLOR="seagreen"]'Initiates FileSystem Object
[/COLOR]
[COLOR="seagreen"]'SET PATHs[/COLOR]
strDeveloperTestPath = "C:\Users\Agnieszka\Documents\Computers\Programming\Database Work\Projects\Molecular\Ordering DB (Terry)\"
strLiveServerPath = "\\wm-icpmr\Data2\SHARED\Cidmls\Ordering\Data\"
strBEfile = "CIDMLS_Ordering_BE.mdb"
strLDBfile = "CIDMLS_Ordering_BE.ldb"
strLOCKfile = "SysMain.bak" [COLOR="seagreen"]'just a text file that access can read/write (named so to scare colleagues to leave it alone).
'comment out appropriate line.
' strBEpath = strLiveServerPath
[/COLOR] strBEpath = strDeveloperTestPath
[COLOR="seagreen"] 'check if .ldb file for BE exists[/COLOR]
If objFileSystem.FileExists(strBEpath & strLDBfile) Then 'it does
[COLOR="seagreen"]'so exit[/COLOR]
DoCmd.Quit
Else
[COLOR="seagreen"]'it does not
'then copy lock system file to working folder
[/COLOR] DoCmd.Hourglass True
[COLOR="Red"] Pause (10)[/COLOR] [COLOR="seagreen"]'hate wasting time, but not sure how to make it do both count and check.
[/COLOR] FileCopy strBEpath & "SystemFolder\" & strLOCKfile, strBEpath & strLOCKfile
End If
[COLOR="seagreen"]'COMPACT CHOSEN DATABASE, TO TEMPORARY DATABASE NAME[/COLOR]
DBEngine.CompactDatabase strBEpath & strBEfile, strBEpath & "CR_" & strBEfile
[COLOR="seagreen"]'DELETE OLD DATABASE[/COLOR]
Kill strBEpath & strBEfile
[COLOR="seagreen"]'RENAME TEMPORARY DATABASE TO ORIGINAL NAME
[/COLOR] Name strBEpath & "CR_" & strBEfile As strBEpath & strBEfile
[COLOR="seagreen"]'Write today's date in the system C/R date file
[/COLOR] Dim strCRdate As Date
strCRdate = Date
Open strBEpath & "SystemFolder\CRdate.bak" For Output As #1
Print #1, strCRdate
Close #1
[COLOR="seagreen"]'DELETE the copy of the system lock file[/COLOR]
Kill strBEpath & strLOCKfile
[COLOR="seagreen"]'...aaaaaand quit.[/COLOR]
DoCmd.Hourglass False
DoCmd.Quit
Exit_Compact_DB:
Exit Function
Err_Compact_DB:
DoCmd.Hourglass False
strErrorNum = Str(Err.Number)
strErrorDsc = Err.Description
Msg = "Error # " & strErrorNum & Chr(13) & " (" & strErrorDsc & ")" & _
Chr(13) & " in: " & cstrModule & " Compact_DB"
MsgBox Msg, vbMsgBoxHelpButton, "Side-end: Error"
Resume Exit_Compact_DB
End Function
