Conocer el nombre o extraer el nombre de un archivo desde su ruta para activarlo
Estoy tratando de activar un archivo desde su ruta, el archivo se selecciona por medio de msoFileDialogFilePicker, y desde esta ruta lo abro pero no se como activarlo, la intención es copiar unos datos del libro activo al libro seleccionado
Workbooks.Open Filename:=ruta 'nomArchivo = Right(Path, Len(Path) - InStrRev(Path, "\")) Workbooks(nomArchivo). Activate
lo intente como ves con InStrRev pero realmente no e encontrado como utilizarlo
1 Respuesta
hola muchas gracias por la atención
lo que trato de hacer es copiar una linea de un registro a otro libro; tengo una base donde registro la información en la segunda linea de esta,
BASE LIBRO DE TRABAJO
esta linea registrada la copio o exporto a otro libro, el que con anterioridad me verifica si existe y me da lo opción de seleccionarlo, en caso contrario, esta selección se guarda como una ruta para editar en un rango de una hoja
Sub EXPORTAR_REGISTRO()
' EXPORTAR primera linea
ThisWorkbook.Sheets("BASE").Range("A2:Y2").Copy
'Verificar si la ruta o esta vacia
rutar = Hoja15.Cells(2, 3)
If Hoja15.Cells(2, 3) = "" Then
resp = MsgBox("No existe el archivo: " & rutar & vbCr & vbCr & _
"Quieres seleccionar el archivo", _
vbQuestion & vbYesNo, "SELECCIÓN DE ARCHIVO")
If resp = vbNo Then Exit Sub
'
rutar = ThisWorkbook.Path
'selecciono ruta y la guardo en la hoja rutas hoja 15
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Selecciona una archivo"
.AllowMultiSelect = False
.InitialFileName = rutar
If .Show <> -1 Then Exit Sub
rutar = .SelectedItems(1)
End With
Hoja15.Cells(2, 3) = rutar
End If
'Verificar si la ruta existe
If Dir(rutar, vbDirectory) = "" Then
resp = MsgBox("No existe la carpeta: " & rutar & vbCr & vbCr & _
"Quieres seleccionar la carpeta", _
vbQuestion & vbYesNo, "SELECCIÓN DE CARPETA")
If resp = vbNo Then Exit Sub
rutar = ThisWorkbook.Path
'selecciono ruta y la guardo en la hoja rutas hoja 15
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Selecciona una archivo"
.AllowMultiSelect = False
.InitialFileName = rutar
If .Show <> -1 Then Exit Sub
rutar = .SelectedItems(1)
End With
Hoja15.Cells(2, 3) = rutar
End If
'___________________________________________________________________
'abrir el libro
Workbooks.Open fileName:=rutar
'asignar nombre de libro
nomArchivo = Hoja15.Cells(2, 4).Value
'activar el libro
Workbooks(nomArchivo).Activate
'selecionar hoja para agregar linea y pegar datos
Sheets("BASE").Range("A2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("BASE").Range("A2").PasteSpecial Paste:=xlPasteValues
Workbooks(nomArchivo).Save
Workbooks(nomArchivo).Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
'Control:
'MsgBox "Falta ruta de INFORME para exportar registro ", vbInformation, " Operacion No es posible "
'rutaexp = falso
'Exit Sub
End Subbueno de todo esto e podido seleccionar la ruta crearla y guardarla, pero cuando quiero abrir el archivo me genera error 9, ademas si el archivo esta abierto me genera mensaje de confirmación, si deseo abrirlo nuevamente, cosa que no quiero que salga.
La parte de extraer el nombre el archivo de su ruta lo logre con un función directamente en el rango nombre archivo y extensión con esto
Option Explicit Function sacar(ruta As String) As String sacar = Right(ruta, Len(ruta) - InStrRev(ruta, "\")) End Function
En las imágenes no se ven las filas y las columnas. Puedes poner una imagen donde se vean las columnas.
Puedes explicar paso a paso lo que quieres hacer.
Hay varias cosas que no entiendo en tu macro, por eso te pedí que me explicaras lo que necesitas, de esa forma crear la macro nueva.
sal u dos
H o l a:
Te anexo la macro actualizada y una función para buscar el archivo.
Antes de ejecutar la macro, para que haga sentido, en la hoja15, en la celda B3 deberás poner únicamente la ruta y en la celda C3 únicamente el nombre del archivo, por ejemplo:
La macro completa:
Sub EXPORTAR_REGISTRO()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("BASE")
Set h15 = Hoja15
'
'VALIDAR RUTA Y ARCHIVO
ruta = h15.Range("B3")
arch = h15.Range("C3")
If ruta = "" Or arch = "" Then
resp = MsgBox("Datos incompletos. Quieres seleccionar el archivo", _
vbQuestion & vbYesNo, "SELECCIÓN DE ARCHIVO")
If resp = vbNo Then Exit Sub
rutaarch = selarch(ruta, h15)
If rutaarch = "" Then Exit Sub
Else
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
rutaarch = ruta & arch
If Dir(ruta & arch) = "" Then
resp = MsgBox("No existe el archivo : " & ruta & arch & vbCr & vbCr & _
"Quieres seleccionar el archivo", _
vbQuestion & vbYesNo, "SELECCIÓN DE ARCHIVO")
If resp = vbNo Then Exit Sub
rutaarch = selarch(ruta, h15)
If rutaarch = "" Then Exit Sub
End If
End If
'ABRIR EL ARCHIVO
Set l2 = Workbooks.Open(Filename:=rutaarch)
Set h2 = l2.Sheets("BASE")
'COPIAR, PEGAR Y GUARDAR ARCHIVO
h1.Range("A2:Y2").Copy
h2.Range("A2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
h2.Range("A2").PasteSpecial Paste:=xlPasteValues
l2.Close True
End Sub
'
Function selarch(ruta, h15)
'Por.Dante Amor
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Selecciona una archivo"
.Filters.Clear
.Filters.Add "xls.*", "*.xls*"
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show <> -1 Then Exit Function
selarch = .SelectedItems(1)
'Actualizar la hoja15
h15.Range("B3") = Left(selarch, InStrRev(selarch, "\"))
h15.Range("C3") = Mid(selarch, InStrRev(selarch, "\") + 1)
End With
End FunctionLa macro revisa los datos de la hoja15, si están en blanco te envía un mensaje para seleccionar el archivo.
Si la ruta y arch no existen, te envía un mensaje para seleccionar el archivo.
Si no seleccionas el archivo, termina.
Si seleccionas el archivo te actualiza la hoja15.
Abre el archivo, copia, pega y guarda.
Ahora, si el libro está abierto y ya le hiciste cambios, pero no haz guardado esos cambios, te envía la Advertencia. Qué quieres hacer, ¿qué la macro guarde el archivo para que de esa forma no te envié el mensaje?
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
muchísimas muchísimas gracias.
si preferiría que el archivo no se vea en este caso que no envié el mensaje y se guarde. muchas gracias
No entendí tu comentario.
Estás trabajando con 2 libros. El libro 1 tiene la macro. El libro2 es el archivo destino.
Si estás modificando el archivo destino y no los has guardado y lo quieres abrir con la macro, te va a enviar el mensaje de Advertencia.
Lo que se puede hacer con la macro es
Opción 1. Detener la macro y enviarte un mensaje, para que revises el archivo destino y revises lo que tengas que revisar.
Opción 2. Guardar el archivo destino y que la macro continúe.
sal u dos
¡Gracias! gracias.
HOLA
Que pena retomar es que me genera erro 424 en esta parte
Set h2 = l2.Sheets("BASE")en la selección de la hoja destino
No es ninguna molestia, te explico lo que sucede.
El libro destino tiene que tener una hoja llamada "BASE".
Eso es lo que tenías en tu macro:
Sheets("BASE"). Range("A2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAboveSi no tiene una hoja llamada "BASE", entonces en dónde se va a pegar la información?
Sin duda hay que realizar varias validaciones para que se pueda copiar información de un archivo a otro; y con gusto te ayudo con todas ellas, pero deberás crear una pregunta para cada petición.
