General |
6.165 Evitare una multisessione di Access |
Giorgio Rancati |
Richiamando la funzione che segue all'apertura di un database Access, si verisfica se tale database è già aperto, nel qual caso il database viene subito richiuso evitando che venga aperta una seconda sessione di tale database. Function IsMultisession() AS Boolean 'Questa Routine è stata sviluppata da GIORGIO RANCATI ' Dim NomeLdb as String Dim i AS Integer NomeLdb = Application.CurrentDb.Name Mid(NomeLdb, Len(NomeLdb) - 2, 3) = "Ldb" 'Apro l'LDB e controllo che non sia maggiore di 64 byte 'Ogni 64 byte è un accesso al Db Open NomeLdb For Binary Access Read Write As #1 If LOF(1) > 64 Then i = -1 Close #1 If i Then MsgBox "Impossibile aprire il database nello stesso tempo più di una volta" Application.Quit 'Non serve ritornare nessun parametro perchè 'l'applicazione viene interrotta brutalmente End If IsMultisession=False End FunctionIn alternativa alla funzione di cui sopra scritta da Giorgio Rancati, per non aprire un database in multisessione si può usare le funzioni che seguono, di autore non conosciuto e basate su DDE. '*********************************************************************** ' As duas funções a seguir rodam em qualquer versão do Access e servem ' para checar se já existe uma instância do arquivo mdb aberta. ' Caso positivo, a função IsRunning() não permite a nova abertura ' do banco de dados. ' ' FUNÇÕES: IsRunning() e TestDDELink(ByVal strAppName$) ' '*********************************************************************** Function IsRunning() Dim db As DAO.Database Set db = CurrentDb() If TestDDELink(db.Name) Then MsgBox "Avviso:" & "@@L'aplicativo è già in esecuzione in" _ & vbCrLf & "un'altra istanza di Windows!", vbCritical, "Seconda istanza di un applicativo" Application.Quit acQuitSaveNone End If End Function ' Função Auxiliar de IsRunning() Function TestDDELink(ByVal strAppName$) As Integer Dim varDDEChannel On Error Resume Next Application.SetOption ("Ignore DDE Requests"), True varDDEChannel = DDEInitiate("MSAccess", strAppName) ' When the app isn't already running this will error If Err Then TestDDELink = False Else TestDDELink = True DDETerminate varDDEChannel DDETerminateAll End If Application.SetOption ("Ignore DDE Requests"), False End Functio La funzione IsRunning() fa riferimento alla libreria Microsoft DAO quindi, se si usa una versione di Access successiva ad Access 97, occorre aggiungere ai riferimenti del database tale libreria. |