Recherche sur serveur d'un emplacement fichier avec lien hypertexte VBA

Bonjour à tous,

J’ai un souci avec un fichier VBA, après beaucoup de tentatives je n'arrive pas à trouver la solution.

Je vous explique; je souhaite que l'utilisateur de ce tableau puisse appuyer sur une référence et se faire rediriger vers un emplacement d'un serveur.

Dès que l'utilisateur appuie sur une cellule il pourrait alors voir les fichiers concernant cette référence de manière automatique.

Malheureusement, je n'y arrive pas.

Voilà ce que j'ai déjà fait en PJ. J'y ai détaillé mon besoin ainsi que le code déjà créé.

Merci beaucoup par avance.

Bonjour

Je vous conseille d'éviter les liens hypertextes. Si par hasard vous deviez déplacer le fichier ou changer le nom du répertoire de sauvegarde, vous serez obligé de tout refaire. Préférez plutôt le double click dans la cellule pour vous diriger vers et ouvrir le document

exemples ici -->

https://forum.excel-pratique.com/s/goto/324187
https://forum.excel-pratique.com/s/goto/937563

Il faut juste adapter un peu puisqu'il faut trouver le dossier correct en premier sur base des premiers caractères. L'idéal serait qu'il y ait toujours le nombre de caractères identiques soient de 4 ou de 3, sinon cela complique un peu

Merci beaucoup pour votre réponse Dan.

En effet, c’est un véritable problème le nombre de caractères au départ. Je ne peux malheureusement rien changer à cela.

Je vais un peu essayer avec ce que vous m'avez donné.

Merci

Ok. Le code sera un peu plus long...

essayez comme ceci dans votre fichier posté

- Click droite sur l'onglet Feuil1
- Choisissez l'option "visualiser le code"
- Dans la fenêtre coller le code ci-dessous

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    nomfichier = Target.Value
    Call Trouvefichier
End If
Cancel = True
End Sub

Dans un module, mettez ce code

Public nomfichier As String
Sub Trouvefichier()
Dim Chemin As String
Dim Sousdossier As Object, Dossier As Object
Dim Fichier

Chemin = "C:\REF\"

Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Sousdossier In Dossier.SubFolders
    For Each Fichier In Sousdossier.Files
        If nomfichier = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) Then
            Shell Environ("WINDIR") & "\explorer.exe " & Sousdossier, vbNormalFocus
            Exit Sub
        End If
    Next Fichier
Next Sousdossier
MsgBox "Le fichier n'est pas trouvé"
End Sub

Attention, la première ligne de code doit absolument se trouver en première dans le module

Double cliquez sur une référence en colonne A. Si le fichier existe, le code ira ouvrir le répertoire contenant le fichier.

Cordialement

Merci Dan,

J'ai essayé votre formule, mais aucun fichier ne se trouve.

Je pense que la recherche est un peu dure a cause du coté aléatoire des espaces et nombre d'élément a notre disposition pour la recherche.

Déjà je pense qu'il ne faut pas chercher le nom du fichier, mais du sous-dossier (car certains dossiers peuvent ne rien contenir)

Du genre :

Public nomfichier As String
Sub Trouvefichier()
Dim Chemin As String
Dim Dossier As Object
Dim Sousdossier

Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Sousdossier In Dossier.SubFolders

If nomfichier = Left(Dossier.Name, InStr(Dossier.Name, ".") - 1)

Après pour :

If nomfichier = Left(Dossier.Name, InStr(Dossier.Name, ".") - 1

Ça ne permet pas de rentrer dans les sous-dossiers, mais uniquement dans le premier niveau de dossier j'ai l'impression.

Mais après je ne suis pas un expert en VBA, mais peu être que la solution se trouve la (formule trouvé en surfant sur le net que j'ai un peu adaptée)? :

 
Sub Test()

    Dim I As Integer
    Dim T() As String

    T = DossierRecursif("C:\REF", True)

    For I = 1 To UBound(T)
    'adapter ici pour le traitement des fichiers
        Debug.Print T(I)
    Next I

End Sub

Function DossierRecursif(Dossier As String, _
                         DebutFichier As String, _
                         AvecSousDossier As Boolean) As String()

    Dim Tbl() As String
    Dim Fso As Object
    Dim Dos As Object
    Dim SousDos As Object
    Dim D As Object
    Dim DosParent As String
    Dim I As Integer
    Dim Fichier As Object

    'mémorise le chemin du dossier
    DosParent = Dossier

    Set Fso = CreateObject("Scripting.FileSystemObject")

    If Fso.FolderExists(Dossier) = False Then Exit Function

    Set Dos = Fso.GetFolder(Dossier)

    'recherche dans les fichiers du dossiers en cours
    For Each Fichier In Dos.Files

        If Dir(Fichier) = Dir(DebutFichier & "*") Then
            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = Fichier
            'si juste le nom sans le chemin
            'Tbl(I) = Fichier.Name
        End If

    Next Fichier

    'si la recherche doit aussi être faite dans les sous-dossiers
    If AvecSousDossier = True Then

        Set SousDos = Dos.SubFolders

        'boucle sur les dossiers
        For Each D In SousDos

            'évite l'erreur des dossiers interdits
            On Error Resume Next

            'cherche les fichiers

            Next Fichier

            'recherche dans les sous dossiers

            DossierRecursif DosParent & "\" & D.Name, _
                            DebutFichier, _
                            AvecSousDossier

        Next D

    End If

    DossierRecursif = Tbl()

End Function

Mais ça m'a l'ai plus complexe , et j'aime bien votre idée d'appeler le Sub "Trouve fichier" indépendamment.

Merci beaucoup pour votre cordiale aide,