PB Enregistrement réseau

Bonjour,

J'ai actuellement un fichier sur un réseau accessible à tous.

Le problème est que ce réseau ne porte la même lettre suivant le poste de l'utilisateur.

Je précise que l'adresse du fichier est la même pour tous à l'exception de la lettre du disque réseau.

J'ai récupéré ce code sur un sujet précédent qui permet d'enregistrer un fichier sur un réseau similaire au mien

en cherchant le nom du dossier quelque soit la lettre du réseau.

Ci-après le code cité au-dessus.

Sub enregistrer()
Dim nomf As String
    Application.DisplayAlerts = False
    On Error GoTo erreur

    nomf = Lettre_Lecteur_De("ASSISTANT QUALITE") & _
        ":\ASSISTANT QUALITE\Calcul des Indicateurs\OTD clients mensuel\" & Range("E15").Value & "_" & Range("E19").Value & ".xlsx"

    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=nomf, FileFormat:=xlOpenXMLWorkbook
    Exit Sub

erreur:
    MsgBox "Erreur : " & Err.Number & vbLf & Err.Description
End Sub

Function Lettre_Lecteur_De(Repertoire As String) As String
Dim FSO As Object, Drv As Object

    Lettre_Lecteur_De = "C"
    Set FSO = CreateObject("Scripting.FileSystemObject")

    For Each Drv In FSO.Drives
        If Drv.IsReady And Drv.DriveType = 3 Then
            If ExisteRep(Drv.DriveLetter & ":\" & Repertoire) Then
                Lettre_Lecteur_De = Drv.DriveLetter
            End If
        End If
    Next
    Set FSO = Nothing
    Set Drv = Nothing
End Function

Function ExisteRep(NTtk As String) As Boolean
    On Error Resume Next
    ExisteRep = GetAttr(NTtk) And vbDirectory
End Function

Je possède déjà un code me permettant d'enregistrer mon fichier à son emplacement et d'en faire un backup dans un sous-dossier.

Je souhaite adapter le premier code cité à mon fichier et à la fonction d'enregistrement en backup de mon code actuel.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

' Terminer les constantes avec un anti-slash \
Const Chemin1 = "Z:\2ESC\CDP\"                                           ' Emplacement 1 du fichier ex: fichier source
Const Chemin2 = "Z:\2ESC\CDP\99_Backup Prog Indiv\"                      ' Emplacement 2 du fichier ex: fichier archive

Dim chemin As String, QuelChemin As String

Application.EnableEvents = False
Application.DisplayAlerts = True

' 1- Le fichier actif est sauvegardé sur lui-même
On Error GoTo Error001
chemin = ThisWorkbook.Path
QuelChemin = chemin
If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
ThisWorkbook.Save

' 2- Le fichier actif est copié sur Chemin1
'    Si différent de Thisworkbook.fullname (idem pour chemin2)
QuelChemin = Chemin1
If LCase(chemin) <> LCase(Chemin1) Then ActiveWorkbook.SaveCopyAs Chemin1 & ThisWorkbook.Name
QuelChemin = Chemin2
If LCase(chemin) <> LCase(Chemin2) Then ActiveWorkbook.SaveCopyAs Chemin2 & ThisWorkbook.Name & Format(Now, "dd-mm-yy hhmm") & ".xlsm"

Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

Error001:
  MsgBox "ATENTION " & vbCrLf & vbCrLf & "Le fichier actif n'a pas été sauvegardé sur : " & _
  vbLf & QuelChemin & "" & vbCrLf & vbCrLf & "Veuillez vérifier que le support " & _
        "externe ou réseau est accessible ou bien que le chemin existe"
  Application.DisplayAlerts = True
  Application.EnableEvents = True
  Exit Sub
End Sub

Merci de l'aide que vous pourrez m'apporter.

Bonjour,

Sur un serveur accessible à tous, tu peux pointer directement le dossier comme ça :

\\Nom_du_Serveur\Nom_du_Dossier

à essayer dans l'explorateur de fichier

Bonjour,

J'ai tenté de modifier le code avec les instructions que vous m'avez transmises mais cela ne marche pas.

D'autres idées ?

Tu as bien essayé :

nomf = "\\Nom_du_Serveur\ASSISTANT QUALITE\Calcul des Indicateurs\OTD clients mensuel\" & Range("E15").Value & "_" & Range("E19").Value & ".xlsx"

en remplaçant Nom_du_Serveur par le nom du serveur (accessible depuis le gestionnaire de fichiers de windows) ?

Fausse alerte !

Je me suis trompé dans la saisie de l'adresse réseau, ça fonctionne parfaitement merci beaucoup !