Macro copiar y pegar ruta de Archivo en celda

Tengo una macro que me deja elegir una carpeta y me muestra su ruta en un MsgBox, pero también necesito que copie esa ruta y me la pegue en una celda.Es algo sencillo pero se me ha dificultado un pocoEste es el códigoPrivate Type BROWSEINFO ' used by the function GetFolderNamehOwner As LongpidlRoot As LongpszDisplayName As StringlpszTitle As StringulFlags As Longlpfn As LonglParam As LongiImage As LongEnd TypePrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" _Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib "shell32.dll" _Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongFunction GetFolderName(Msg As String) As String' returns the name of the folder selected by the userDim bInfo As BROWSEINFO, path As String, r As LongDim X As Long, pos As IntegerbInfo.pidlRoot = 0& ' Root folder = DesktopIf IsMissing(Msg) ThenbInfo.lpszTitle = "Selecciona una carpeta"' the dialog titleElsebInfo.lpszTitle = Msg ' the dialog titleEnd IfbInfo.ulFlags = &H1 ' Type of directory to returnX = SHBrowseForFolder(bInfo) ' display the dialog' Parse the resultpath = Space$(512)r = SHGetPathFromIDList(ByVal X, ByVal path)If r Thenpos = InStr(path, Chr$(0))GetFolderName = Left(path, pos - 1)ElseGetFolderName = ""End IfEnd FunctionSub TestGetFolderName()Dim FolderName As StringFolderName = GetFolderName("Selecciona una carpeta")If FolderName = "" ThenMsgBox "No has seleccionado ninguna carpeta"ElseMsgBox "Haz seleccionado la carpeta: " & FolderName Range("A1").Value = FolderNameEnd IfEnd Sub

by http://www.todoexpertos.com/categorias/tecnologia-e-internet/software-y-aplicaciones/microsoft-excel/respuestas/2370398/macro-copiar-y-pegar-ruta-de-carpeta-en-celda

Yo necesito genere la ruta de un archivo (ppt en este caso)

No he podido modificar la macro :-(

1 Respuesta

Respuesta
2

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

Tanto tu macro como mi macro su objetivo es llegar hasta las carpetas.

Si quieres seleccionar un archivo, necesitas otro tipo de código.

Tu pregunta original es: "pero también necesito que copie esa ruta y me la pegue en una celda"

Y eso que pediste lo hace cualquier de las 2 macros. Repito si quieres el nombre de un archivo necesitas otra macro, por lo tanto, podrías finalizar esta pregunta y crear una nueva solicitando en específico la ruta y el nombre del archivo, en mensaje y en cuál celda .

Saludos. DAM

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas