Macro copiar y pegar ruta de Archivo en celda

No se entiende bien la macro, se amontonó al momento de pegarla.

Puedes pegarla primero en word y luego de word a aquí.

O si puedes enviarme tu archivo con la macro.

Saludos. DAM

Private Type BROWSEINFO '
used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare
Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As
String) As Long
Private Declare
Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function
GetFolderName(Msg As String) As String
' returns the name
of the folder selected by the user
Dim bInfo As
BROWSEINFO, path As String, r As Long
Dim X As Long, pos
As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selecciona una carpeta"
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
Sub
TestGetFolderName()
Dim FolderName As
String
FolderName = GetFolderName("Selecciona una carpeta")
If FolderName = "" Then
MsgBox "No has seleccionado ninguna carpeta"
Else
MsgBox "Haz seleccionado la carpeta: " & FolderName
End If
End Sub

Lo siento es cierto no se pego bien anexo Gracias

Solamente agrega la siguiente línea

Range("A5") = FolderName

después de esta línea

MsgBox "Haz seleccionado la carpeta: " & FolderName

O cambia toda tu macro solamente por esto:

Sub ruta()
'Por.DAM
On Error Resume Next
Set nv = CreateObject("shell.application")
    carpeta = nv.browseforfolder(0, "Selecciona una carpeta", 0, wpath).items.Item.path
    If carpeta = "" Then
        MsgBox "No has seleccionado ninguna carpeta"
    Else
        MsgBox "Haz seleccionado la carpeta: " & carpeta
        Range("A5") = carpeta
    End If
End Sub

Saludos.DAM
No olvides finalizar la pregunta.

Es correcto llego al nivel de las carpetas con la macro mas esbelta que mencionas, Pero aun no accedo a los documentos.

el objetivo de la macro es insertar la ruta completa de un documento en el equipo (pdf,ppt,txt etc)

ejemplo:

"C:\Users\Public\Downloads\P&L Lazaro Cardenas.PNG"

con la formula que tenia y la que mencionas solo llego a:

"C:\Users\Public\Downloads\

Te agradezco espero me puedas apoyar

Ssaludos