Microsoft 365 Message d'erreur avec nom de l'utilisateur

[Claudy]

Bonjour,
j'utilise la macro ci dessous pour sauver une feuille au format .pdf.
Elle fonctionne très bien ...sauf si le fichier existant est déjà ouvert sur un autre poste de travail.
Comment empêcher le bug en affichant un message d'erreur qui me dirait que le fichier est ouvert sur le poste de ZAZA?
Dans le genre : msgbox("Le fichier " & Range("B1").text & "est ouvert sur le poste de travail de " & Application.user )'
Merci d'avance,

Claudy


Sub PDF_SAVE()

' Création fichier PDF

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"B:\COMMUN\BLABLA\DISPONIBILITE CHARROI ZP\" & Range("B1").Text & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False

End Sub

 

[patricktoulon]

re
bonjour
comme tu parle de poste de(....) je suppose que ce fichier est en reseau
il faut donc tester si le fichier est utilisé

un petit exemple parmis tant d'autres

Sub test()
    MsgBox estOuvert("C:\Users\polux\DeskTop\translate interface.xlsm")
End Sub
Function estOuvert(fichier As String)
    Dim x As Integer, E As Integer
    x = FreeFile()
    estOuvert = False
    On Error Resume Next
    Open fichier For Input Lock Read As #x
    Close x
    E = Err
    On Error GoTo 0
    Select Case E
    Case 0: estOuvert = False
    Case 70: estOuvert = True
    Case Else: estOuvert = E
    End Select

End Function

 

[Claudy]

re
bonjour
comme tu parle de poste de(....) je suppose que ce fichier est en reseau
il faut donc tester si le fichier est utilisé

un petit exemple parmis tant d'autres

Sub test()
    MsgBox estOuvert("C:\Users\polux\DeskTop\translate interface.xlsm")
End Sub
Function estOuvert(fichier As String)
    Dim x As Integer, E As Integer
    x = FreeFile()
    estOuvert = False
    On Error Resume Next
    Open fichier For Input Lock Read As #x
    Close x
    E = Err
    On Error GoTo 0
    Select Case E
    Case 0: estOuvert = False
    Case 70: estOuvert = True
    Case Else: estOuvert = E
    End Select

End Function

Re bonjour,
ok merci ça fonctionne , mais ça ne ma dit pas quel poste sur le réseau.....
A+
Claudy

 

[patricktoulon]

re
je ne sais pas si c'est possible , il faudrait que l'utilisateur ai donné la permission mais la je suis en dehors de mon champ de compétences

 

[sylvanu]

Bonjour le fil,
Tout dépend de la structure de votre réseau et des règles de sécurité mise en place par votre service informatique.
Sur un réseau "bien fait" la seul réponse du réseau à votre requête sera "Fichier non disponible" ou "Fichier en cours d'utilisation".

 

[sylvanu]

La seule solution que j'avais trouvé a été de lancer un "ping" toutes les 10min avec un code ressemblant à celui de Patrick.
Si le fichier était dispo, je l'ouvrais et je mettais un message bien visible sur l'écran d'Excel.