[VBA]Récubérer chemin dossier source en "C6"

'*****Création Table des matières*****
Private Sub CommandButton1_Click()
'adaptée de:
'http://www.developpez.net/forums/showthread.php?t=342976
'Par Moâ ;-)
'Définir le chemin du répertoire en "C6"
Dim a As Variant
a = MsgBox("Voulez vous créer la table des matières ?" & vbCrLf & "Ceci peut prendre quelques secondes" & vbCrLf & "Merci", vbYesNo + vbExclamation, "Initilisation de la recherche...")
If a = vbNo Then Exit Sub
Application.ScreenUpdating = False
Selection.AutoFilter Field:=1
Range("B6").Value = "*"
Rows("9:65536").Select
Selection.ClearContents
Selection.FormatConditions.Delete
Range("B6").Select
Dim chemin As String
Dim i As Integer
Dim objFSO As Object, objFile As Object
chemin = Range("C6") 'C'est ICI que l'on choisi le chemin
Set objFSO = CreateObject("Scripting.FileSystemObject")
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = chemin
.SearchSubFolders = True
.Execute
Cells(8, 1).Value = "N°"
Cells(8, 2).Value = "Nom Dossier"
Cells(8, 3).Value = "Nom fichier"
Range("A88").Font.Bold = True
With .FoundFiles
For i = 1 To .Count
Cells(i + 8, 1) = i
Worksheets(1).Hyperlinks.Add Cells(i + 8, 3), .Item(i)
Cells(i + 8, 3).Hyperlinks(1).TextToDisplay = Dir(.Item(i))

Set objFile = objFSO.GetFile(.Item(i))
Cells(i + 8, 2) = Dir(objFSO.GetParentFolderName(objFile), vbDirectory)

Next i
End With
End With

Columns("C").AutoFit
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=SI($A14>0;MOD(LIGNE();2)=0)"
Selection.FormatConditions(1).Font.ColorIndex = 1
With Selection.FormatConditions(1).Interior
.PatternColorIndex = 15
.Pattern = xlGray25
End With
Selection.Font.Bold = True
Range("B6").Select
Application.ScreenUpdating = True
MsgBox "Génération de table" & vbCrLf & "terminée." & vbCrLf & "Merci" & vbCrLf & "LJA", _
vbInformation, "Fin de recherche"
End Sub

Cliquez pour agrandir...

'*****Ouverture de la boîte de dialogue chemin*****
Private Sub CommandButton3_Click()
Dim objShell, objFolder, chemin, SecuriteSlash
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Sélection du dossier à analyser", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:"
End If
If objFolder.Title = "" Then
chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
Range("C6").Value = chemin
End Sub

Cliquez pour agrandir...