Disconnecting users and removing .laccdb file - Office 365 - vba

I have .adcde frontend + .accdb backend database located on local shared drive, used by 10 users at the moment. They are using shortcuts to access frontend file. I have struggled to make regular updates as users constantly left DB open so I implemented idea from MSDN website ( https://learn.microsoft.com/en-us/office/troubleshoot/access/shut-down-custom-application-remotely )
Solution works well on my machine, however, when utilized in user environment, it seems to leave .laccdb locks on both frontend and backend (which I deduct should be closed in moment when last connection to frontend closes)
Any hints? Do I understand this structure incorrectly?
Private Sub Form_Open(Cancel As Integer)
boolCountDown = False
DoCmd.Maximize
DoCmd.Restore
Me.Visible = False
End Sub
Private Sub Form_Timer()
On Error GoTo Err_Form_Timer
Dim strFileName As String
strFileName = Dir(filelocation/chkfile.ozx)
If boolCountDown = False Then
If strFileName <> "chkfile.ozx" Then
boolCountDown = True
intCountDownMinutes = 2
End If
Else
intCountDownMinutes = intCountDownMinutes - 1
'DoCmd.OpenForm "aShutDownWarning"
Me.Visible = True
Me.SetFocus
Forms!aShutDownWarning!txtWarning.Caption = "This application will be shut down in approximately " & intCountDownMinutes & " minute(s) due to maintenance works. Please save all work."
If intCountDownMinutes < 1 Then
Application.Quit acQuitSaveAll
End If
End If
end sub

That should work but I guess, since the laccdb files are still there, that one or more user are actually not logged out.
If they logg out from their account or from their computer the Access files can still be open but not running, so your code is not really running.
I solved a similar situation by adding usernames to a table when they start the program and delete the same username when program are closed. That way I could see users that was not logged out by a similar code.

If you're able to delete the .laccdb files manually then no one is still logged in and some user's Access session was simply unable to clean up after itself when it terminated. This might be caused by a user not having delete access to the folder where the .laccdb file is. Otherwise, someone is still logged in. You can use the Jet UserRoster to see who is logged in. If you want to make your own viewer see https://learn.microsoft.com/en-us/office/troubleshoot/access/determine-who-is-logged-on-to-database or see this utility at https://www.utteraccess.com/topics/1897146

Related

Can I use VBA in Access to determine if a user has multiple instances of a database open?

I am looking for a way to determine if a user current has multiple instances of an Access database open on their machine. The purpose of this check would be to ensure better session handling.
It is perfectly fine for a user to open multiple instances. There are some elements of our work where this is a necessity, to browse existing records while entering a new one.
I came across this old forum post where a function is given to output a list of the currently open databases in the Workspace. I thought I may be able to adapt this to determine if the same database is open more than once on their machine. However, in testing the function (removing the part that opens a separate database), it always outputs the name of our database twice, regardless of whether I have just one instance open, or two or three.
Here's the adapted code I am using:
Public Sub listDBs()
Dim wrkCurrentWorkSpace As Workspace
Dim i As Integer
Dim strDatabases As String
Set wrkCurrentWorkSpace = DBEngine.Workspaces(0)
For i = 0 To wrkCurrentWorkSpace.Databases.Count - 1
If (i = 0) Then
strDatabases = wrkCurrentWorkSpace.Databases(i).Name
Else
strDatabases = strDatabases & Chr$(13) & Chr$(10) & wrkCurrentWorkSpace.Databases(i).Name
End If
Next
MsgBox strDatabases
Set wrkCurrentWorkSpace = Nothing
End Sub
Am I doing something wrong here?

Weird Issue With Windows Service - Service Timing Out

Hi there I have piece of legacy (VS2010) Windows Service code that I have imported into VS2017 and is causing me severe frustration. This code has worked well for about the last 6 years, however when I carry out the install and attempt to start the service the SCM comes back with a timeout error. The OnStart code is as follows:
Protected Overrides Sub OnStart(ByVal args() As String)
'Instaniate the timer for the service
_serviceTimer = New Threading.Timer(New Threading.TimerCallback(AddressOf Tick), Nothing, 60000, 60000)
End Sub
The call back is:
Private Sub Tick(ByVal state As Object)
'Switch off the timer event whilst the code executes
_serviceTimer.Change(System.Threading.Timeout.Infinite, System.Threading.Timeout.Infinite)
If Not _started Then
Startup()
_started = True
End If
Call ServerProcess()
'Re-enable the timer now that application code has completed
_serviceTimer.Change(_longInterval, _longInterval)
End Sub
I originally had the Startup process in the OnStart method, however removed it as an attempt at resolving this issue, however it has not made any difference. Method Startup is as follows:
Public Sub Startup()
Try
'Source these settings from the local config file
_appDataFolder = Utilities.GetSetting("AppDataRoot")
_configPathMapped = _appDataFolder & Utilities.GetSetting("ConfigPathMapped")
_logPath = _appDataFolder & "\" & utl.GetSetting("LogPath")
'Instaniate the timer for the service - Commented out after moving startup code from OnStart method
' _serviceTimer = New Threading.Timer(New Threading.TimerCallback(AddressOf Tick), Nothing, Timeout.Infinite, Timeout.Infinite)
'Initialise logging architecture
_logger = New aslLog.Logger(_configPathMapped & "nlog.config", _logPath, My.Application.Info.ProductName, My.Application.Info.Version.ToString)
_logger.SendLog("Started PSALERTS Schedule Server Service", NLog.LogLevel.Info, _serviceTimer, _checkInterval, Nothing)
'Determine if the cloned config files exists in the mapped config file folder
'We clone these files to a writable destination to allow us to overcome write restrictions ot the C: drive on the SPEN PTI Desktop model
If Not System.IO.File.Exists(_configPathMapped & "psaservermachine.config") Then
'Clone the app.config file in the config folder as psaservermachine.config
Utilities.CloneFile(_programFileLocation & "PSALERTSScheduleServer.exe.config", _configPathMapped & "psaservermachine.config")
End If
If Not System.IO.File.Exists(_configPathMapped & "nlog.config") Then
'Clone the nlog.config file
Utilities.CloneFile(_programFileLocation & "PSALERTSScheduleServer.exe.config", _configPathMapped & "nlog.config")
End If
'Determine the Oracle TNS Environment
'Check for the existence of the environment variable 'TNS_ADMIN'
If Environment.GetEnvironmentVariable("TNS_ADMIN") IsNot Nothing Then
'If TNS_ADMIN exists then we can continue with the application session
Else
Dim oraTnsPath As String = ""
'If it doesn't exist then we need to determine the Oracle information from the PATH environment variable
oraTnsPath = GetOraTnsPath()
If oraTnsPath <> "" Then
'Then create the TNS_ADMIN environment variable
Environment.SetEnvironmentVariable("TNS_ADMIN", oraTnsPath)
Else
'If no oracle client information exists then raise an error to this effect and exit the app
'informing the user that they need to install the Oracle client in order to use PSALERTS
Beep()
Throw New PSALERTSOracleConfigException(
"PSALERTS Oracle Configuration Error. PSALERTS Did not find a valid Oracle Client." & vbCrLf & vbCrLf &
"Please install a valid Oracle Client and try again." & vbCrLf & vbCrLf &
"If a valid Oracle Client is installed then ensure that the PATH environment variable contains an entry for the Oracle Client." & vbCrLf & vbCrLf &
"For example - TNS_ADMIN=C:\oracle\12.1.0\Client_lite\NETWORK\ADMIN"
)
End If
End If
'Register the application
If Not Registered() Then
'Register the application
Register()
End If
If Registered() Then
'Clean/close any stray Excel processes from previous debug session
If _debugModeOn Then
CleanUpRedundantProcesses("EXCEL", "PSALERTS")
End If
'instantiate fresh excel session
_myXLApp = New Excel.Application
'Get the timer interval settings
_longInterval = CType(utl.GetSettingServerMachine(_configPath, "appSettings", "LongIntervalMillis"), Integer)
_initInterval = CType(utl.GetSettingServerMachine(_configPath, "appSettings", "InitialIntervalMillis"), Integer)
_refreshInterval = CType(utl.GetSettingServerMachine(_configPath, "appSettings", "InitialIntervalMillis"), Integer)
'Re-start the timer with periodic signalling as per the specified check interval
_serviceTimer.Change(_initInterval, _initInterval)
Else
_started = False
End If
Catch ex As Exception
_logger.SendLog("PSALERTS Schedule Server startup failure.", NLog.LogLevel.Error, ex)
Finally
End Try
End Sub
I use a similar technique for a number of similar services and they are running fine. Would appreciate some insight from any Windows Service gurus out there. Oh, I use WiX to carry out the install, again this is a well worn template for a number of similar such applications.
Kind Regards
Paul J.
Core: The very most typical errors:
Config problems: connection strings, faulty paths, etc...
Boot startup problem (good list - from FAQ)
Wrong password / login account when running as a real user with password.
Files missing or runtimes missing.
Permission problems (ACL / NT Privilege missing).
Maybe check this answer before the below.
UPDATE: Maybe have a look at this previous answer. Service startup timing issue. Also check my ad-hoc answer there in the same page.
Debugger: Other than that - nothing like stepping through the code with a debugger. I haven't done that in a long time. Deploy debug binaries and try? Windows 10 now hides messages from services - not sure how that affects debuggers: No more switching to Session 0.
I am not a service guru, but a deployment specialist. I'll just provide some links and see if that helps. Maybe I have not fully understood the whole problem. I tend to focus on the deployment side and not so much development side.
Ideas List / Debugging Check List: These are "ideas lists" for what could be wrong for applications in general - not just services (two first lists are similar - created some time apart):
Crash on launch
Desktop application won't launch
General purpose WiX / MSI links
Yes, these lists are very generic - too large to digest. Just skim the first two I think.
Debugging Tools: Also a reminder of the most useful service debugging tools: Event Viewer, Task Manager, Services.msc, Process Explorer (system internals), The NET command and SC.exe.
Good Service FAQ: https://www.coretechnologies.com/WindowsServices/FAQ.html
Your startup method should fire up a background worker and quickly return to the SCM that it has started. There is a system wide default setting of 30 seconds but honestly a proper service should respond in a few seconds.
Looking though your code, your connection to the database is probably the long pole causing the problem.

how to use environ function to avoid other from using my Access DB

I manage an Access DB (accdb) and it contains some information about my company that I don´t want others to access it out of my company´s server.
I thought to use Environ (5)=computername or Environ (12)=path to retrieve some references such as LEN(environ(path)). With this function, I could, for instance, make sure that the accdb file only works if LEN(environ(path))/2+15=55 (the lenght at my company´s server divided by 2 plus 15 = 80/2+15=55 = algorhytm).
So, on opening the db, it should prompt for a number/code. If the user inserts 55 and the filepath = 80, it will open. If filepath=100 (filepath out of my company´s server), must be prompted 100/2+15=65 to open the db.
Unfortunelly, I don't know how to programe it neither I know how to block the use of SHIFT (that breakes the VBA code on opening) because I'm a rookie.
So, if you please, can you help me to solve these huge problems (1. algorhytm using Environ, 2. avoid using SHIFT on opening).
Thanks in advance.
Bruno
Add this code to your startup form. When the form opens it will check for the username and computername, and if both match the form will open.
Private Sub Form_Open(Cancel As Integer)
If Not (Environ("username") = "santosh" And Environ("computername") = "ABC-CAP1-093") Then
Cancel = True
Application.Quit
End If
End Sub
Avoid using shift key - I have already answered see this link

Update an excel file by multiple users at same time without opening the file

Scenario
I have an excel file that contains data. There are multiple users accessing the file at the same time.
Problem
There will be problem if multiple users tried to input data to that excel file at the same time due to only one user is allowed to open the file at one time
Question
Is there any way whereby I can update the excel file (Eg: add a value to a cell, delete a value from a cell, find a particular cell etc) without opening it so that multiple users can update it at the same time using excel VBA?
I went to the direction of using shared files. But later found out to be excel shared files are very buggy. If use shared file, excel/macro can be very slow, intermittent crashes and sometime the whole file may get corrupted and could not be opened or repaired afterwards. Also depends on how many users use the file, the file size can grow quite big. So it is best not to use shared workbook. Totally not worth trying. Instead if need multiple users to update data simultaneously, it is better to use some database such as MSAccess, MSSql (Update MSSQL from Excel) etc with excel. For my situation since number of users are less, I didn't use any database, instead put a prompt for the user to wait until the other user close that file. Please see the codes below to check if a file is opened and if so, to prompt user. I got this code from stack overflow itself and I modified to suit my needs.
Call the module TestFileOpened as below.
Sub fileCheck()
Call TestFileOpened(plannerFilePathTemp)
If fileInUse = True Then
Application.ScreenUpdating = True
Exit Sub
End If
End Sub
Here plannerFilePathTemp is the temporary file location of your original file. Whenever an excel file opened, a temp file will be created. For example, your original file location is as below
plannerFilePath = "C:\TEMP\XXX\xxx.xlsx"
Thus your temporary file location will be
plannerFilePathTemp = "C:\TEMP\XXX\~$xxx.xlsx"
or in other words, temporary file name will be ~$xxx.xlsx
The following codes will be called upon Call TestFileOpened(plannerFilePathTemp)
Public fileInUse As Boolean
Sub TestFileOpened(fileOpenedOrNot As String)
Dim Folder As String
Dim FName As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
fileInUse = True
MsgBox "Database is opened and using by " & GetFileOwner(fileOpenedOrNot) & ". Please wait a few second and click again", vbInformation, "Database in Use"
Else
fileInUse = False
End If
End Sub
Function GetFileOwner(strFileName)
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
GetFileOwner = objSD.Owner.Name
Else
GetFileOwner = "Unknown"
End If
End Function
I encountered Out of memory issues also when used shared files. So during the process, I figured out the following methods to minimize memory consumption
Some tips to clear memory

VBA Excel won't connect to Access DB on another computer

A colleague of mine is trying to use an excel tool that pulls data from an access database. The tool works perfectly on my computer but he is having the issue that the tool is unable to connect with the Access database.
I've tried solving the problem by checking that the excel options are correct i.e. making sure macros are enabled etc. but I'm still getting the problem.
The problem must be something in my colleagues settings that hasn't been configured because the tool works without any issues for me. Here are some of the parts of the code that read the Access DB:
Public Const pActuarialPWD = "password2"
Public Const QuoteDB = "N:\DWH\Commercial Ins\Fleet\Databases\Quote DB.accdb"
If bDBOpen = False Then
'Connect to database
If openQuotedb() = False Then
MsgBox "Connection to database failed - contact Actuarial"
Exit Sub
End If
End If
Function openQuotedb()
On Error GoTo ErrorHandler
openQuotedb = False
Set db = OpenDatabase(QuoteDB, False, False, "MS Access;PWD=" & pActuarialPWD)
openQuotedb = True
Exit Function
ErrorHandler:
MsgBox "Couldn't connect to database. Please contact actuarial. Tool should not be used, as quote information will be lost", vbCritical
End Function
I've stepped through the program both in my computer and my colleagues a number of times and I can't see what the problem is. When I step past the line of code "db = ..." on my colleagues PC and hover over db it reads "db = Nothing" whereas on mine it successfully connects to the database.
Have you any ideas what might be going wrong here. It just seems exces is not setup properly to connect to Access on my colleagues PC.
The only thing I can think of is that I am using Excel 2013 and my colleague is on 2010.
The function below have saved me a lot of trouble. I don't know if it will solve your problem but in general will help.
I have tested it in many applications and with a variety of changes and variables and it worked every time and has never failed me. Maybe will help you.
Public Function db_connect(Optional sel_db As Variant = "", Optional pass_be As Variant = ";PWD=<password>") As DAO.Database
Dim db As DAO.Database
If sel_db = "" Then
sel_db = "<database_path>"
End If
On Error GoTo db_locked:
Set db = DBEngine.OpenDatabase(sel_db, True, False, pass_be)
GoTo DBclose:
db_locked:
Sleep 100
Set db = DB_Connection.db_connect(sel_db, pass_be)
DBclose:
Set db_connect = db
End Function
To call the function just do:
Dim db As DAO.Database
Set pers = DB_Connection.db_connect("full_path or your path with the N drive mapped", ";PWD=<db_password>")
WARNING-DISCLAIMER!!!
Be careful. The function has a waiting mechanism and tries to connect without never stoping. If you have wrong parameters or the database doesn't exist then it will stuck in an infinite loop. I never bothered to fix it because I knew the problem and avoid it. However, you can make improvements if you want.