XL 2016 Contrôle de l'existence d'un répertoire

[christ77000]

Bonjour à tous, j'ai une fonction qui me permet de tester si un répertoire existe. Je travail sur un fichier chez moi et au boulot j'ai donc dans une liste de choix deux possibilitées de répertoire. quand je reste sur le choix du chemin du boulot la cellule F12 ne passe pas à 0 et je ne voit pas ou est le bug. Merci pour votre aide.

Chemin du boulot : \\Srvfichiersvjs007toto\communication_v5$\1. Sécurité & Environnement\Accueil sécurité\
Chemin maison : j:\Srvfichiersvjs007toto\communication_v5$\1. Sécurité & Environnement\Accueil sécurité\

Sub Teste_Dossier_Existe_5()
'---test du 1er lien---
Sheets("Reseau").Select

Dim MonDossier As String
On Error Resume Next
MonDossier = Range("B12").Value

    If DossierExiste(MonDossier) = True Then
        Range("F12").Value = 1
    Else
        Range("F12").Value = 0
    End If

End Sub


Public Function DossierExiste(MonDossier As String)
' ---Macro pour tester les liens d'accès aux fichiers---

   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
  
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function

 

[sylvanu]

Bonjour Christ,
J'ai testé votre macro et elle marche correctement.
Testez cette PJ pour voir si le phénomène ne viendrait pas d'autre part.

 

[christ77000]

Bonjour Sylvanu, j'ai oublié de préciser que je passe par ce code et que je renvoie sur un autre code qui va sur mon précédent message

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B4")) Is Nothing Then
Call Test_reseau
End If

If Not Intersect(Target, Range("B6")) Is Nothing Then
Call Test_reseau
End If

If Not Intersect(Target, Range("B8")) Is Nothing Then
Call Test_reseau
End If

If Not Intersect(Target, Range("B10")) Is Nothing Then
Call Test_reseau
End If

If Not Intersect(Target, Range("B12")) Is Nothing Then
Call Test_reseau
End If

End Sub

Sub Test_reseau()
Call Teste_Dossier_Existe_1
Call Teste_Dossier_Existe_2
Call Teste_Dossier_Existe_3
Call Teste_Dossier_Existe_4
Call Teste_Dossier_Existe_5
End Sub

serait 'il possible que se soit le cumul du contrôle qui bug je vais de suite isoler chaque contrôle pour vérifier. Merci pour ton aide

 

[christ77000]

RE et bien non fonctionne pas !!!

 

[christ77000]

ce sont les chemin réseaux qui bloquent quand je met
\\Srvfichiersvjs007.toto\communication_v5$\1. Sécurité & Environnement\Accueil sécurité\ dans votre fichier la cellule ne passe pas à 0

 

[patricktoulon]

re
bonjour

Sub je_suis_ou_là()
x = where
MsgBox x
End Sub
Function where() As varint
    d1 = "\\Srvfichiersvjs007toto\communication_v5$\1. Sécurité & Environnement\Accueil sécurité\"
    d2 = "j:\Srvfichiersvjs007toto\communication_v5$\1. Sécurité & Environnement\Accueil sécurité\"
    Select Case True
    Case Dir(d1, vbDirectory) <> "": where= d1
    Case Dir(d2, vbDirectory) <> "": where= d2
    Case Else: where= False
    End Select
End Function

 

[christ77000]

bonjour Patricktoulon vu mon petit niveau en vba pourrait tu m'expliquer ce que fait ton code. Remplasse t'il autre chose ou vient 'il en complément. Merci pour ton aide.

 

[patricktoulon]

mon code est sensé te dire ou tu es en te renvoyant un chemin ou l'autre
ou ( false si tu n'es ni au boulboul ni a la maison)
a condition que tes chemins soient valides bien sur

dans les 2 premiers cas tu a le chemin a dispo directement sans te poser la question "ou je suis"

 

[christ77000]

ok, merci pour l'explication. Mais sachant que j'ai en B12 le choix 1 ou 2, comment placer ton code ?

 

[patricktoulon]

en b12 mais chaque choix dans une feuille différente c'est ça?????

 

[christ77000]

oui, les cinq testes renvoie sur 5 choix de lien différents et dans ces 5 choix il y a donc le chemin maison et boulot.

 

[patricktoulon]

bon ben quand tu répondra a ma question (et pas à coté)peut être que l'on avancera

 

[christ77000]

oups désolé, les cinq choix sont dans la feuille réseau en B4, B6, B8, B10 et B12 Je joint le fichier.