Importation Lien depuis Sharepoint

Bonjour à tous et à toutes, je cherche à faire une macro me permettant de prendre un lien sur une plateforme SharePoint en fonction d'une valeur dans une cellule.

Voila plus exactement ce que je cherche à faire:

1. Récupérer un lien sur SharePoint en fonction du nom de la cellule (Si la cellule contient "Rapport1", il faudrait récupérer le fichier "Rapport1.pdf")
2. Appliquer le lien à la cellule
3. Passer à la cellule suivante

Comme vous avez pu le comprendre c'est sur le 1. que je bloque, et conscient que je demande quelque chose de compliquée je vous remercie de n'importe quelle aide apportée.

J'avais réalisé quelque chose qui correspondrait à peut près à ton besoin si j'ai bien compris, je te le donne, il te restera à l'adapter ;)

Le principe était de chercher à partir d'un dossier, un fichier dans l'ensemble des sous dossiers et de lister l'ensemble des fichiers correspondants avec Chemin dossier et nom.

Fonction d'appel :

Sub Lunch()
    Dim path As String, fso As Scripting.FileSystemObject, SRC As Scripting.Folder, i As Integer
    Set fso = New Scripting.FileSystemObject
    i = 2
    path = SelectFolder
    If Not path = vbNullString Then
        If Acces(path) Then
            Set SRC = fso.GetFolder(path)
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            DerouleFolder SRC, i, 1
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
        Else
            MsgBox "[Erreur] L'accès à " & path & " est impossible, vérifier avant de procéder.", vbCritical + vbOKOnly, "Accès indisponible"
        End If
    End If
    Exit Sub
fin:
    MsgBox "Une erreure est survenue.", vbInformation + vbOKOnly, "Procédure non aboutie"
End Sub

Fonction qui check l'accès au SharePoint (en effet, certains n'ont pas les droits):

'Vérifie qu'on a accès au dossier
Private Function Acces(path As String) As Boolean
    On Error GoTo fin
    Dim rFld As Scripting.Folder, oFSO As Scripting.FileSystemObject
    Set oFSO = New Scripting.FileSystemObject
    Set rFld = oFSO.GetFolder(path)
    If rFld.path <> "" Then
        Acces = True
    Else
        Acces = False
    End If
    Exit Function
fin:
    Acces = False
End Function

Fonction qui va permettre de sélectionner le dossier parent à partir d'où chercher (peut être remplacer par un chemin fixe) :

'Fonction demande de selection de dossier à l'utilisateur
Private Function SelectFolder() As String
    Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        '.InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With
    If sFolder <> "" Then
        SelectFolder = sFolder
    Else
        SelectFolder = vbNullString
    End If
End Function

Fonction récursive pour parcourir l'ensemble des sous dossiers :

'fonction récurssive pour parcourir l'ensemble des sous dossiers
Private Sub DerouleFolder(Fld As Scripting.Folder, ByRef ligne As Long, iteration As Long)
    Dim fil As Scripting.File, subfold As Scripting.Folder
    'permet d'éviter les "ne répond plus", tous les 20 sous-dossiers on refresh un peu
    If (iteration Mod 20) = 0 Then
        ThisWorkbook.Application.ScreenUpdating = True
        Application.Wait Time + TimeSerial(0, 0, 1)
        ThisWorkbook.Application.ScreenUpdating = False
    End If

    For Each fil In Fld.Files
        If InStr(UCase(fil.name), "Rapport 1") > 0 _
           And InStr(UCase(fil.name), "Copie de ") = 0 _
           And Right(fil.name, 4) = ".pdf" Then
            WriteFile fil, ligne
            ligne = ligne + 1
        End If
    Next fil

    For Each subfold In Fld.SubFolders
        Select Case UCase(subfold.name)
            Case "Exception": 'les noms de dossiers  à ne pas parcourir, nothing
            Case Else: DerouleFolder subfold, ligne, iteration + 1
        End Select
    Next subfold
End Sub

Fonction qui écrit résultat dans Feuil1

Private Sub WriteFile(fil As Scripting.File, ligne As Integer)
    With ThisWorkbook.Worksheets("Feuil1")
        .Range("B" & ligne).value = IIf(Len(fil.ParentFolder.path) > 255, fil.ParentFolder.shortpath, fil.ParentFolder.path)
        .Range("C" & ligne).value = IIf(Len(fil.name) > 255, fil.ShortName, fil.name)
    End With
End Sub