Como crear un macro para seleccionar la ruta de un archivo que esta en mi pc desde un browser
Soy nuevo manejando macros aki mi pregunta, necesito seleccionar de forma automática la ruta de un archivo que esta en mi PC, para poder trabajar con la información que esta almacenada en dicho archivo(un Excel), actualmente lo que hago es en una celda escribo la ruta completa y luego en el macro abro el archivo y lo trabajo, entonces para el usuario es complicado estar escribiendo la ruta (la mayor parte de veces se equivocan y se cae el proceso), por eso la necesidad de tener un macro que me permita seleccionar el archivo y traerme la ruta completa, algo asi como que se me abra un browser y seleccionar de ahi el archivo, capturar la ruta y trabajarlo.
Cualquier comentario estaré muy agradecido.
Sigue las Instrucciones para un botón y ejecutar la macro
1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona Asignar macro / Selecciona: abrearchivo
9. Aceptar.
10. Para ejecutarla dale click a la imagen.
Sub abrearchivo()
'Por.Dam
ruta = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "xls.*", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ruta
'.Show
If .Show Then
arch = .SelectedItems.Item(1)
Workbooks.Open arch
End If
End With
End SubPrueba y me comentas
Saludos. DAM
Si es lo que necesitas.
Muchas gracias por la respuesta rápida realmente funciono, también como para aportar encontré esto que lo pego a continuación, pero creo que tu macro es mas eficiente
Muchas Gracias
Saludos Cordiales
Henrry
Sub SelectFolderOrFile()
'-- Hwnd is always 0. Title is browse window caption. RootFolder is optional top folder to show.
'-- Options has several possibilities:
'-- 1 - only allows selection of system folders. (doesn't seem to work.)
'-- 2 - don't show network folders below domain level. (doesn't work on stand-alone system.)
'-- 8 - only allow selection of File System ancestors(??) (on stand-alone system nothing can be selected.)
'-- 16 - adds a text input but only valid entries will be returned; cannot create a folder.
'-- 4096 - only computers can be selected.
'-- 8192 - only a printer can be selected.
'-- 16384 - full browsing, includes files.
'-- This script uses the FolderItems object properties to Get path and
'-- find out what type of item it is.
'---------------------------------------------------------
Dim ShellApp, Ret, s, i
Set ShellApp = CreateObject("Shell.Application")
On Error Resume Next
Set Ret = ShellApp.browseforfolder(0, "Choose a file or folder", 16384)
s = Ret.Title
If Err.Number <> 0 Then
WScript.Quit
End If
s = GetPath(Ret, i)
MsgBox s '& " - " & cstr(i) &vbcrlf&vbcrlf&"0-namespace. 1-drive. 2-folder. 3-file." '--show full path and type of item returned. 0-namespace. 1-drive. 2-folder. 3-file.
Set ShellApp = Nothing
WScript.Quit
End Sub
Function GetPath(Fil, iItem)
Dim Pt1, fPar, sn, Obj, sType
On Error Resume Next
sn = Fil.Title
'MsgBox "sn (File/Folder title): " & sn
Set fPar = Fil.parentfolder
'MsgBox "fPar (File/Folder parent Folder): " & fPar
Set Obj = fPar.parsename(sn) '--return item selected as a Shell FolderItem.
'MsgBox "Obj (return item selected as a Shell FolderItem): " & Obj
'--weed out namespaces and drives. If it's a namespace or drive it can't
'--return a FolderItem so the last Call caused an error and Obj is therefore
'--Not part of the filesystem:
If Obj.isfilesystem = False Then
Pt1 = InStr(sn, ":")
If Pt1 = 0 Then
iItem = 0 '--namespace.
GetPath = sn
Else
iItem = 1 '--drive.
GetPath = Mid(sn, (Pt1 - 1), 2) & "\" '--Get letter before : and add "\" If drive.
End If
Set Obj = Nothing
Exit Function
End If
'--it's a file or folder. find out which and Get path:
sType = Obj.Type '--Get object Type as shown in folder Details view.
'MsgBox "sType (Get object Type as shown in folder Details view): " & sType '-- Should be able to use: If Obj.IsFolder = True..... but it doesn't work.
If InStr(sType, "Bestandsmap") = 0 Then '-TAALGEVOELIG-in detail view a folder will be type "File Folder".
iItem = 3 '--file.
Else
iItem = 2 '--folder.
End If
GetPath = Obj.Path
Set Obj = Nothing
End Function
