Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Conoscere da quale PC è in uso un determinato file

Ultimo Aggiornamento: 06/02/2023 11:07
Post: 111
Registrato il: 01/06/2016
Città: PISA
Età: 64
Utente Junior
2003
OFFLINE
28/01/2023 09:33

Buongiorno a tutti,
ho una cartella su un server dove ci sono miei programmi excel che possono essere utilizzati da più PC. Quindi su ogni PC si può accedere ad ognuno di questi programmi, a patto che non sia già utilizzato da un altro operatore (in quel caso avvisa che il file è già in uso e pone la domanda se lo si vuole aprire solo in lettura, etc...).
Per avere un quadro della situazione ho creato un programma a parte, dove sono elencati i nomi dei miei programmi e nella cella a fianco viene visualizzato se attualmente è in uso, se disponibile o fuori uso (quest'ultimo in casi eccezionali...)
Il codice (che, per essere onesto, non è tutta farina del mio sacco) che controlla il tutto è questa:

Public Function fOpenError(filename As String) As Integer
Dim fNum As Integer
On Error Resume Next
fNum = FreeFile()
Open filename For Input Lock Read As #fNum
Close fNum
fOpenError = Err
On Error GoTo 0
End Function

Public Sub TestPIPPO()
Select Case fOpenError("\\ABCServer\PIPPO\Programmi Miei\PIPPO.xls")
Case 0 ' nessun errore
Range("B3").Value = "DISPONIBILE"
Case 70 ' il file è già aperto
Range("B3").Value = "Attualmente in USO"
Case Else ' altro errore
Range("B3").Value = "FUORI USO"
End Select
End Sub

Public Sub TestPLUTO()
Select Case fOpenError("\\ABCServer\PIPPO\Programmi Miei\PLUTO.xls")
Case 0 ' nessun errore
Range("B4").Value = "DISPONIBILE"
Case 70 ' il file è già aperto
Range("B4").Value = "Attualmente in USO"
Case Else ' altro errore
Range("B4").Value = "FUORI USO"
End Select
End Sub

Public Sub TestPAPERINO()
Select Case fOpenError("\\ABCServer\PIPPO\Programmi Miei\PAPERINO.xls")
Case 0 ' nessun errore
Range("B5").Value = "DISPONIBILE"
Case 70 ' il file è già aperto
Range("B5").Value = "Attualmente in USO"
Case Else ' altro errore
Range("B5").Value = "FUORI USO"
End Select
End Sub

Quindi, nell'esempio, nella cella A3 ho scritto il nome PIPPO, nella A4 il nome PLUTO e nella A5 il nome PAPERINO: e, tramite un pulsante che aggiorna estemporaneamente la situazione, funziona alla grande.
La mia domanda è questa:
è possibile indicare nelle rispettive celle C3, C4 e C5 il nome del PC sul quale è aperto il file corrispondente?

Chiaramente i programmi presenti nella cartella sono una ventina ma, per semplificare, ho postato la macro (con nomi modificati) tenendo conto solo di tre programmi (PIPPO.xls, PLUTO.xls e PAPERINO.xls) poichè, capito il codice da dover eventualmente utilizzare (grazie al vostro prezioso aiuto), la cosa si ripete sempre...
Io vi ringrazio già da ora per l'aiuto (spero sia fattibile) e la pazienza che mi dedicherete.
Restando in attesa, approfitto per salutare tutti voi.
Elio

PS - spero di essermi espresso bene e di non aver omesso nulla...
🙏
[Modificato da elioeco 28/01/2023 09:38]
EcoBand
Post: 3.391
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
28/01/2023 16:19

ciao
[C U T]

scusate avevo interpretato male la richiesta.....

saluti
[Modificato da dodo47 28/01/2023 16:23]
Domenico
Win 10 - Excel 2016
Post: 111
Registrato il: 01/06/2016
Città: PISA
Età: 64
Utente Junior
2003
OFFLINE
30/01/2023 10:41

Re: ???
dodo47, 28/01/2023 16:19:

ciao
[C U T]

scusate avevo interpretato male la richiesta.....

saluti




EcoBand
Post: 3.392
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
30/01/2023 11:40

ciao
ho testato il seguente codice MA non avendo una rete non so se funziona (sul mio pc si)

metti per esempio in a1 la path completa del file compresa l'estensione, poi in B1:

=GetFileOwner(A1)

Dovresti ottenere nome pc / user DEL PC

Ovviamente da integrare con il tuo codice in caso di err=70

altro non saprei suggerire

saluti

Option Explicit
Option Compare Text


Function GetFileOwner(fileName As String) As String
Dim secUtil As Object
Dim secDesc As Object
Dim File_Shortname As String
Dim fileDir As String
 
    File_Shortname = Dir(fileName)
    fileDir = Left(fileName, InStr(1, fileName, File_Shortname) - 1)
    Set secUtil = CreateObject("ADsSecurityUtility")
    Set secDesc = secUtil.GetSecurityDescriptor(fileDir & File_Shortname, 1, 1)
    GetFileOwner = secDesc.owner
    
End Function


[Modificato da dodo47 30/01/2023 11:41]
Domenico
Win 10 - Excel 2016
Post: 112
Registrato il: 01/06/2016
Città: PISA
Età: 64
Utente Junior
2003
OFFLINE
31/01/2023 15:37

Ciao Dodo e grazie per l'interesse (sempre puntuale a dare una mano),
in realtà a me servirebbe che nelle celle C3, C4 e C5, mi appaia, nel caso sia attualmente utilizzato, il Nome utente; praticamente ciò che c'è scritto nel campo: Excel Menù Strumenti->Opzioni->Generale->Nome utente.
Ho provato ad inserire il codice che gentilmente mi hai scritto; però mi compare, giustamente, il nome di chi si è logato su quel PC e non se sta utilizzando in quel momento il file... (credo sia così...). Probabilmente, anzi sicuramente, mi ero espresso io male...
Sarà fattibile?
In realtà, alla fine, dovrebbe apparirmi una cosa del genere (vedi PDF allegato).
Sono nelle tue mani.

[Modificato da elioeco 31/01/2023 15:58]
EcoBand
Post: 3.393
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
31/01/2023 17:29

ciao
si, l'avevo capito infatti ti ho detto che quella routine rileva quanto hai constatato:
dodo47:

Dovresti ottenere nome pc / user DEL PC


e ti avevo suggerito di integrarlo con il tuo codice (su err=70).

Premesso che al Nome utente, da Excel Menù Strumenti->Opzioni->Generale non ci si arriva (a mia conoscenza) avevo pensato:
"se intercetti l'err=70 vuol dire che il file è aperto, ora chi si può loggare con le proprie credenziali su un pc ? spero solo 1" oppure non è così?

Un'alternativa sarebbe quella di utilizzare un log (file txt), ma ti costringerebbe ad intervenire su ciascuno di questi programmi nel modo seguente:
su open vai a registrare sul log USER - PC

In questo modo, sempre sull'open ti vai prima a spazzolare il log e fai i tuoi controlli. Se uno chiude il file, su before_Close vai a cancellare User e PC.

Ora l'ho detta in modo sbrigativo ma il concetto potrebbe essere questo e a te non resterebbe altro che leggere il log.

Non saprei cos'altro proporti....sorry

saluti
[Modificato da dodo47 31/01/2023 17:30]
Domenico
Win 10 - Excel 2016
Post: 113
Registrato il: 01/06/2016
Città: PISA
Età: 64
Utente Junior
2003
OFFLINE
01/02/2023 09:13

Ciao dodo,
ho provato (se non ho capito male) a variare la riga di codice:

Case 70 ' il file è già aperto
Range("B3").Value = "Attualmente in USO"

in:

Case 70 ' il file è già aperto
Range("B3").Value = GetFileOwner(A3)

ma mi da "Errore di compilazione" - Tipo non corrispondente per l'argomento ByRef"...

Avrò sicuramente sbagliato ad interpretarti, in più mi ci metto anche a chiedere soluzioni che vanno ben aldilà delle mie comprensioni...

EcoBand
Post: 3.394
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
01/02/2023 09:48

ciao
presumo che in A3 ci sia path e file comprensivo di estensione.

Prova a dichiarare una variabile as String, gli assegni il valore di A3 e poi la passi come argomento alla Function GetFileOwner che, per l'appunto, pretende una stringa.

saluti




[Modificato da dodo47 01/02/2023 09:48]
Domenico
Win 10 - Excel 2016
Post: 114
Registrato il: 01/06/2016
Città: PISA
Età: 64
Utente Junior
2003
OFFLINE
02/02/2023 14:20

Ciao Dodo,
proprio così: in A3, come in A4, A5, An... ci sono le path comprensive di nomefile con estensione....
è quello che mi hai scritto dopo che non so come gestire... 😄😄😄 (nel senso che non ho capito un gran chè)
(non sono un mostro come voi in VBA... ma se puoi spegarmi con esempi passo passo, probabilmente riesco a capire...)

Saluti.
Elio
[Modificato da elioeco 02/02/2023 14:23]
EcoBand
Post: 3.396
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
02/02/2023 18:09

Ciao
si, in effetti ho tirato dritto....sorry

PROVA magari su un pc stand alone prima
Public Function fOpenError(fileName As String) As String
Dim fNum As Integer
Dim secUtil As Object
Dim secDesc As Object
Dim File_Shortname As String
Dim fileDir As String
Dim mErr
On Error Resume Next
fNum = FreeFile()
Open fileName For Input Lock Read As #fNum
Close fNum
mErr = Err
On Error GoTo 0
If mErr = "70" Then
    File_Shortname = Dir(fileName)
    fileDir = Left(fileName, InStr(1, fileName, File_Shortname) - 1)
    Set secUtil = CreateObject("ADsSecurityUtility")
    Set secDesc = secUtil.GetSecurityDescriptor(fileDir & File_Shortname, 1, 1)
    fOpenError = secDesc.owner
End If
End Function


saluti

EDIT:

Tieni presente che sia che ti venga segnalato che il file Pippo è in uso, sia no, essendo una UDF i dati non si aggiornano in automatico.
Mi spiego meglio:
Ti viene segnalato che Pippo è aperto. Se l'utente lo chiude, a te resterà sempre la segnalazione a meno che non ricalcoli il tutto (F9) (e viceversa naturalmente)
[Modificato da dodo47 02/02/2023 19:23]
Domenico
Win 10 - Excel 2016
Post: 115
Registrato il: 01/06/2016
Città: PISA
Età: 64
Utente Junior
2003
OFFLINE
06/02/2023 09:56

Fantastico!
Comunque metterò anche un pulsante per aggiornare in tempo reale la lista...
Grazie, come sempre, del preziosissimo aiuto.
🙏🙏🙏🙏🙏🙏🙏🙏
EcoBand
Post: 3.397
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
06/02/2023 11:07

Re:
elioeco, 06/02/2023 09:56:

....Comunque metterò anche un pulsante per aggiornare in tempo reale la lista...


ciao
ti basta una semplice istruzione, pe:
Sub Aggiorna()
calculate
End Sub

saluti







Domenico
Win 10 - Excel 2016
Post: 3.398
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
06/02/2023 11:07

Re:
[------C U T------]

Post duplicato.

saluti







[Modificato da dodo47 06/02/2023 16:14]
Domenico
Win 10 - Excel 2016
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 03:34. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com