XL 2016 Erreur d'éxécuriton 1004 et problème d'enregistrement de fichier

[JPrev]

Bonjour les forumers,

J'ai besoin d'une petite aide pour un fichier que j'ai créé et que je souhaite partager entre une bonne quantité d'utilisateurs.

J'ai programmé une macro qui fait une copie d'un formulaire rempli par l'utilisateur pour l'enregistrer avec des variables. Jusque-là, sur mon PC, tout va bien, ça marche parfaitement.

Le problème : Sur n'importe quel autre PC, j'ai le message d'erreur (voir PJ).

Que dois-je faire pour solutionner le problème?

Merci sincèrement pour vos retours .
JPrev

 

[sylvanu]

Bonjour Jprev,
Etes vous sur que sur tous les PC le chemin soit en M:\Share\.... ?

 

[JPrev]

Bonjour Sylvanu, c'est un lecteur en partage donc oui!

 

[sylvanu]

Pourtant le message d'erreur est explicite. Le VBA n'arrive pas à accéder à votre dossier réseau.
Pouvez vous sur un PC tester ce petit code :

Sub AccesDisque()
 If DisqueExiste("C") Then MsgBox "Disque C: existe." Else MsgBox "Disque C: n'existe pas."
 If DisqueExiste("M") Then MsgBox "Disque M: existe." Else MsgBox "Disque M: n'existe pas."
 End Sub
Function DisqueExiste(LettreDisque As String)
 Set fso = CreateObject("Scripting.FileSystemObject")
 DisqueExiste = fso.DriveExists(LettreDisque)
 Set fso = Nothing
End Function

Pour vérifier que le VBA reconnait bien M: ( le C: est juste là pour vérifier que la macro fonctionne correctement )

 

[JPrev]

Merci pour votre réponse. Le lecteur M: est un commun où tout le monde a accès, le problème ne vient pas de là.
Je pense plus que le problème vient de la dernière chaîne de caractère du chemin "EA78E000" que je ne connais pas...

 

[sylvanu]

Peut être une solution :
Sur un PC dans Explorer vous allez dans le bon dossier et vous récupérer dans la barre d'adresse le chemin que vous collez dans le VBA.

 

[JPrev]

Sylvanu, en fait vous aviez raison, les lettres des disques sont différentes selon quelques personnes (M:, P: et U: notamment).

Auriez-vous une boucle qui permettrait d'identifier sur quelle lettre le code peut exercer l'enregistrement avant de passer à une étape suivante?

Merci,

JPrev

 

[sylvanu]

Je pense qu'il est plus simple de passer par l'adresse réseau du serveur.
Du genre : \\NomServer\Dossier\..... et là il est le même pour tout le monde.
( par ex au boulot j'utilise \\a610s019\hard\..... )

VBA: obtenir l'adresse réseau d'un fichier (UNC) | Excel-Malin.com

Fonctions VBA qui vous permettent de facilement obtenir l'adresse réseau unique (UNC) d'un lecteur ou d'un fichier. Code VBA tout prêt!

excel-malin.com

Sinon il va falloir essayer les 26 lettres avec l'arborescence et gérer les erreurs d'accès. Ca risque d'être long et coton.
Essayez la première méthode. Si ça ne donne rien, revenez ici.

 

[JPrev]

J'avoue que la procédure là dépasse mes compétences ...

Est-il possible de créer une boucle sur quelques lettres? Globalement j'ai du P, M et U

Merci

 

[sylvanu]

Quand vous avez installer M: sur votre PC, vous avez du préciser l'adresse du dossier sur le réseau.
C'est cette adresse que vous devez utiliser :

 

[sylvanu]

Sinon vous pouvez utiliser la macro du post #4 modifiée :

Sub NumeroDisque()
Dim LettreDisque As String
    LettreDisque = ""       ' au cas où le disque ne serait ni M ni P ni U
    If DisqueExiste("M") Then LettreDisque = "M:"
    If DisqueExiste("P") Then LettreDisque = "P:"
    If DisqueExiste("U") Then LettreDisque = "U:"
End Sub
Function DisqueExiste(LettreDisque As String)
 Set fso = CreateObject("Scripting.FileSystemObject")
 DisqueExiste = fso.DriveExists(LettreDisque)
 Set fso = Nothing
End Function

Le nom du disque est dans la variable LettreDisque.

 

[JPrev]

Bonjour Sylvanu,

Merci pour le code, j'ai par exemple moi accès au M: et au P:, est-il possible d'insérer un système de disque "préférentiel"?

Par exemple si le P existe c'est d'abord le P (et la procédure continue avec le P). S'il ne trouve pas, c'est le M...

 

[sylvanu]

Bonjour,
Impossible.
Sur un PC vous pouvez avoir, puisque c'est arbitraire, un disque M: et un disque P: .
Mais sur un PC votre partition sera sur M: et sur un autre ce sera P:, car M: serait utilisé pour un autre disque. Donc même s'il existe cela ne veut pas dire que c'est le bon.

De plus lancez cette macro :

Sub NumeroDisque()
T0 = Timer
Dim LettreDisque As String
    LettreDisque = ""       ' au cas où le disque ne serait ni M ni P ni U
    If DisqueExiste("M") Then LettreDisque = "M:"
    If DisqueExiste("P") Then LettreDisque = "P:"
    If DisqueExiste("U") Then LettreDisque = "U:"
MsgBox Timer - T0
End Sub
Function DisqueExiste(LettreDisque As String)
 Set fso = CreateObject("Scripting.FileSystemObject")
 DisqueExiste = fso.DriveExists(LettreDisque)
 Set fso = Nothing
End Function

Sur mon PC elle prends 23.4ms. Donc rien puisqu'elle n'est utilisée qu'une fois. Donc inutile de se compliquer la vie.

 

[soan]

Bonjour,

Pour le code VBA de sylvanu, je propose cette petite modification de la 1ère sub :

Sub NumeroDisque()
  Dim LettreDisque$
  LettreDisque = ""  'au cas où le disque ne serait ni P, ni M, ni U
  If DisqueExiste("P") Then LettreDisque = "P:": Exit Sub
  If DisqueExiste("M") Then LettreDisque = "M:": Exit Sub
  If DisqueExiste("U") Then LettreDisque = "U:"
End Sub

Inversion des 2 premiers tests => P: est testé en premier, puis M:, puis U: ; ainsi, je crois que ça joue le rôle d'un système de disque "préférentiel", comme le souhaitait JPrev ; cela d'autant plus que l'on sort de la sub dès qu'un disque existe (j'ai enlevé ce qui concerne le timer pour éviter de devoir utiliser un GoTo).

Accessoirement, vous pouvez jouer au tiercé - quarté - quinté plus ; mais je ne sais pas si le PMU validera votre disque préférentiel.

soan

 

[fanch55]

Salut à tous, à tester :

Public Sub Test()
'    [C1] = SearchforDrive([B1].Text)
'    Columns.AutoFit

    MsgBox SearchforDrive("dossier\sousdossier\fichier.zzz")
    
End Sub
Public Function SearchforDrive(File As String) As String
Set Fso = CreateObject("Scripting.FileSystemObject")

    For Each Drv In Fso.Drives
        Select Case True
        Case Not Drv.isready: DoEvents
        Case Fso.FileExists(Drv.rootfolder & File)
            SearchforDrive = Drv.rootfolder & File
            Exit For
        End Select
    Next
    
Set Fso = Nothing
End Function