Aprire database con password in singola istanza

[Davide]

Buonasera,

con un pulsante su una maschera vorrei aprire un altro database di Access (.accdb) protetto da password.


Sul sito di Donkarl (http://www.donkarl.com/it/?FAQ6.19) ho trovato il seguente codice che mi permette di aprire correttamente il database, tuttavia cliccando più volte sul pulsante si aprono più istanze del database.

-----
Dim appAcc As Access.Application
Set appAcc = CreateObject("Access.Application")
appAcc.OpenCurrentDatabase "C:\MioDatabase.accdb", False, "12345"
-----
Dim db As DAO.Database
Dim acc As New Access.Application
Set db = acc.DBEngine.OpenDatabase("C:\MioDatabase.accdb", False, False, ";pwd=12345")
acc.OpenCurrentDatabase "C:\MioDatabase.accdb"
-----



Come posso evitare che venga aperta più di una istanza del database?

Davide

[@Alex]

Mmmmm puoi usare GETOBJECT prima di CREATEOBJECT, e, se ottieni errore 429 usi CRATEOBJECT altrimenti fai fallire...

In sostanza GETOBJECT cerca di usare il Server di Automazione se già Istanziato e ne recupera l'istanza stessa, quindi se già aperto esci... se non aperto lo apri...

On Erorr Goto ERR_OPEN
Set appAcc = GetObject("Access.Application")
If err=0 then Exit Sub
.....
Exit Sub

ERR_OPEN:
Set appAcc = CreateObject("Access.Application")
Resume Next
End Sub


Spero di essere stato chiaro

@Alex

[Davide]

Post by @Alex
Mmmmm puoi usare GETOBJECT prima di CREATEOBJECT, e, se ottieni errore 429 usi CRATEOBJECT altrimenti fai fallire...
In sostanza GETOBJECT cerca di usare il Server di Automazione se già Istanziato e ne recupera l'istanza stessa, quindi se già aperto esci... se non aperto lo apri...
On Erorr Goto ERR_OPEN
Set appAcc = GetObject("Access.Application")
If err=0 then Exit Sub
.....
Exit Sub
Set appAcc = CreateObject("Access.Application")
Resume Next
End Sub
Spero di essere stato chiaro
@Alex

Ciao,

ho provato a scrivere come da tuo consiglio questo codice, ma come risultato viene aperto il database con richiesta della password. Inoltre cliccando di nuovo il pulsante vengono aperte altre istanze. Dove sbaglio?


On Error GoTo ERR_OPEN

Set AppAcc = GetObject("C:\MioDatabase.accdb", "Access.Application")
If Err.Number = 0 Then Exit Sub
AppAcc.OpenCurrentDatabase "C:\MioDatabase.accdb", False, ";PWD=12345"
Exit Sub

ERR_OPEN:
Set AppAcc = CreateObject("Access.Application")
Resume Next

[@Alex]

Debug passo passo...?

@Alex

[Davide]

Post by @Alex
Debug passo passo...?
@Alex

Ciao Alex,

Non viene restituito nessun errore.
All'istruzione
Set AppAcc = GetObject("C:\MioDatabase.accdb", "Access.Application")

consegue che:
se il programma è chiuso lo apre con richiesta della password.
se il programma è già aperto lo riapre con richiesta della password

[@Alex]

Post by Davide

Post by @Alex
Debug passo passo...?
@Alex

Ciao Alex,
Non viene restituito nessun errore.
All'istruzione
Set AppAcc = GetObject("C:\MioDatabase.accdb", "Access.Application")
se il programma è chiuso lo apre con richiesta della password.
se il programma è già aperto lo riapre con richiesta della password

Davide... la logica è OPPOSTA..., in caso di NESSUN ERRORE ESCE.

Quindi:
Se con GETOBJECT viene rilevato ERRORE, significa che NON E' attiva alcuna istanza, quindi ERR=429, di conseguenza la CREO con CREATEOBJECT, ma non resetto l'errore quindi al Resume Next non effettuo Exit Sub e procedo.

Se con GETOBJECT NON vinee rilevato ERRORE, significa Istanza Attiva, ERR=0 e di conseguenza EXIT SUB...

Cosa sfugge in questo...?

Facendo Debug che succede...?

@Alex

[@Alex]

Ovviamente forse sfugge una cosa... che tu non hai chiarito ed io non ho chiesto...!
Se l'eventuale altra ISTANZA è aperta da altro PC chiaramente il codice NON FUNZIONA appoggiandosi ad Automazione quindi CLIENT Locale.
Ma nel tuo caso ho proposto questo SOLO per il fatto che hai detto che il problema esiste dalla macchina in caso di CLICK multipli...!

In tal caso deve andare.

@Alex

[Davide]

Post by @Alex
Ovviamente forse sfugge una cosa... che tu non hai chiarito ed io non ho chiesto...!
Se l'eventuale altra ISTANZA è aperta da altro PC chiaramente il codice NON FUNZIONA appoggiandosi ad Automazione quindi CLIENT Locale.
Ma nel tuo caso ho proposto questo SOLO per il fatto che hai detto che il problema esiste dalla macchina in caso di CLICK multipli...!
In tal caso deve andare.
@Alex

La situazione reale è questa:
Ho sul server una cartella condivisa con dentro vari programmi Access 2007-2010.
Sempre nella stessa cartella ho un programma access "LogIn" (a cui tutti gli utenti sui PC in locale accedono mediante collegamento sul desktop) che gestisce i permessi degli utenti e gli fa vedere solo la lista dei programmi che gli sono consentiti aprire.
Selezionando da questa lista gli utenti aprono il relativo programma.
Ora vorrei mettere una password a tutti i programmi (tranne "LogIn" a cui gli utenti accedono con un id e password personale) in modo che gli utenti non possano aprire i programmi accedendo alla cartella condivisa.
Pertanto devo aggiornare l'istruzione associata al doppioClick sulla lista programmi (finora ho usato l'istruzione "Shell" che apriva una sola istanza, ma ora che c'è una password non è più adatta al mio scopo).

Riguardo l'uso di GetObject, a me non viene restituito errore 429, nè se il programma è chiuso, nè se il programma è già aperto.
Forse il problema è che è già aperta una istanza Access (ossia il programma "LogIn)!?

[Davide]

Ho trovato una soluzione utilizzando le api di Windows trovate a questo link
http://access.mvps.org/access/api/api0041.htm

Con questa funzione che ho creato riesco ad ottenere i titolo delle finestre di access aperte. Bisognerà poi sistemarlo un po (replace, ecc.) per confrontarlo con il nome del file che si vuole aprire o meno.

Public Function VerificaFinestreAccessAperte()

Dim hWndApp As Long
hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)

Do Until hWndApp = 0
If winGetClassName(hWndApp) = "OMain" Then
MsgBox winGetTitle(hWndApp)
End If
hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
Loop

End Function