Newsgroup: it.comp.appl.access
Titolo: Re: non avviare due volte client accde

 Grazie a tutti.
 
 
non è chiaro se vuoi impedire la doppia apertura di msaccess.exe o la 
doppia apertura del tuo file
 
cmq potresti vedere i mutex
 
https://visualbasic.happycodings.com/windows-and-controls/code5.html
 
 
 
BFS
 
-- 
Questa email è stata esaminata alla ricerca di virus da AVG.
http://www.avg.com
 
 

 Grazie a tutti.
 
 
 
Routine realizzata da Giorgio Rancati
 
 
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 IsMultisession = True
Close #1

prova questo:
 
   If SysCmd(acSysCmdRuntime) Then AppAlreadyUp False, True    ' permetti istanze muliple, avverti
 
 
inserire in un modulo:
 
Option Compare Database
Option Explicit
 
Private Declare Function BringWindowToTop Lib "user32" (ByVal lngHWnd As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal lnghObject As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal lngHWnd As Long, ByVal lpString As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal nRelationship As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
 
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hdata As Long) As Long
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lngMutexAttributes As Long, lngInitialOwner As Long, ByVal lpName As String) As Long
 
 
 
' For GetWindow
Const GW_HWNDNEXT = 2
Const GW_HWNDChild = 5
 
' For ShowWindow
Const SW_MAXIMIZE = 3
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
 
conts gProgramma = "xxxx"' sostituire con il nome dell'applicazione 
 
Const ERROR_ALREADY_EXISTS = 183&
 
Public Function AppAlreadyUp(bAllowMultipleInstances As Boolean, bDisplayMsg As Boolean) As Long
 
' Function checks for multiple instances of an application
' by creating a mutex object.  If no error, then this is only
' instance running.
 
    Const RoutineName = "AppAlreadyUp"
    Const Version = "1.0"
 
    Dim lngMutexHandle As Long
    Dim lngHWnd As Long
    Dim lngReturn As Long
    Dim strMsg As String
 
    On Error GoTo AppAlreadyUp_Error
 
    ' Create a muxtex object
    lngMutexHandle = CreateMutex(0, 1, gProgramma) ' 
 
    ' Did we get a new instance or a handle to an existing one?
    If err.LastDllError = ERROR_ALREADY_EXISTS Then
        ' App is already running
        If bDisplayMsg = True Then
            ' Close the handle just created as
            ' it only points to the existing muxtex
            lngReturn = CloseHandle(lngMutexHandle)
 
            If bAllowMultipleInstances = False Then
                strMsg = "Questa applicazione e' gia' in esecuzione su questo computer.  Non si puo' eseguire un'altra istanza."
                strMsg = strMsg & vbCrLf & "Si riattiva l'istanza  gia' in eseguzione."
            Else
                strMsg = "Attenzione: Questa applicazione e' gia' in esecuzione su questo computer."
            End If
            MsgBox strMsg, vbOKOnly + vbCritical, gProgramma
        End If
 
        If bAllowMultipleInstances = False Then
            ' Find the existing instance, switch to it, then close this instance
            lngHWnd = GetWindow(GetDesktopWindow(), GW_HWNDChild)
 
            Do While lngHWnd > 0
                If GetProp(lngHWnd, gProgramma) = 1 Then  
                    BringWindowToTop (lngHWnd)
                    lngReturn = ShowWindow(lngHWnd, SW_MAXIMIZE)
                    Exit Do
                End If
                lngHWnd = GetWindow(lngHWnd, GW_HWNDNEXT)
            Loop
 
            Application.Quit
 
            ' Call application exit routine here or just quit your app.
        End If
 
    Else
        lngReturn = SetProp(Application.hWndAccessApp, gProgramma, 1)  ' "mgLite"
    End If
 
AppAlreadyUp_Exit:
    On Error Resume Next
 
    ' Always return false just to pass something back
    AppAlreadyUp = False
 
    Exit Function
 
AppAlreadyUp_Error:
 
    MsgBox "Routine Name: " & RoutineName & vbCrLf & "Version: " & Version & vbCrLf & "Error Number: " & err.Number & vbCrLf & "Error Description: " & err.Description & vbCrLf & "Error Source: " & vbCrLf & "Error Source: " & err.Source, vbCritical, "Errore"
 
    '    UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl
    Resume AppAlreadyUp_Exit
 
End Function