Buscar, mover y listar imágenes.
Hola experto, de ante mano gracias por su tiempo. Mi duda es la siguiente, estoy creando una macros que almacena diferentes datos y dentro de esos datos quisiera que almacenara una imagen por set de datos, pero no dentro del excel, sino que la moviera a una carpeta predeterminada que se encontrara en la misma carpeta del archivo excel con la macro (para poder direccionarla a un archivo "//imágenes" por ejemplo sin dar una dirección completa como "C://archivos... Bla bla bla"), ahora la idea es que la imagen quede asociada a un set de datos que se encuentra en una fila del excel, para así poder llamarla cuando yo lo necesite o visualice ese set de datos. Bueno, no sé si sera muy complejo o no se entienda, pero agradezco cualquier ayuda que me guie al menos.
Saludos.
Saludos.
1 Respuesta
Respuesta de José Saúl Méndez Alonso
1
Puedes usar el Objeto FileSystemObject para realizar esas tareas de mover o copiar archivos, y para usar como base la ruta del archivo de Excel puedes usar la propiedad Path, ActiveWorkbook. Path, espero te sea de utilidad
Ahora bien si gustas enviarme una copia de tu trabajo con gusto te ayudo a implementar una solución.
Ahora bien si gustas enviarme una copia de tu trabajo con gusto te ayudo a implementar una solución.
Hola, muchas gracias. Pero tengo una duda de como se utiliza ese comando, me podrías dar un ejemplo por favor.
Lo que yo busco es que al rpesionar un botón que esta en un Useform se abra una ventana, como esas de buscar archivos por el computador, y que al seleccionar un archivo el archivo sea copiado a una carpeta predefinida. No sé si me explico bien, si esa función que me das sirve para eso, me podrías dar un ejemplo corto de como ponerla en la macro... es decir:
Sub archivo()
load FileSystemObject
end sub ????
De ante mano gracias.
Lo que yo busco es que al rpesionar un botón que esta en un Useform se abra una ventana, como esas de buscar archivos por el computador, y que al seleccionar un archivo el archivo sea copiado a una carpeta predefinida. No sé si me explico bien, si esa función que me das sirve para eso, me podrías dar un ejemplo corto de como ponerla en la macro... es decir:
Sub archivo()
load FileSystemObject
end sub ????
De ante mano gracias.
Disculpa que te moleste aún, pero es algo así, con este código:
Private Sub CommandButton6_Click()
Application.FindFile
End Sub
Se abre una ventana que me permite buscar un archivo, en este caso imágenes, pero al seleccionarlas yo no quiero que las abra, sino que las copie automáticamente a otra carpeta, y si es posible que les cambie el nombre.
Private Sub CommandButton6_Click()
Application.FindFile
End Sub
Se abre una ventana que me permite buscar un archivo, en este caso imágenes, pero al seleccionarlas yo no quiero que las abra, sino que las copie automáticamente a otra carpeta, y si es posible que les cambie el nombre.
Puedes usar el control COMDLG32.OCX, este control te permite manipular los cuadros de dialogo comunes de Windows, puedes usar el diálogo Abrir pero como lo comentas en lugar de abrirlo le darías la indicación de copiarlo a otra ubicación y con otro nombre esto último lo puedes hacer con el objeto FileSystemObject.
Te dejo este código a ver si te es de utilidad.
De cualquier modo re puedo enviar el ejemplo a tu correo.
Option Explicit
Public sRuta As String
Public FSO As FileSystemObject
Sub AbreArchivo()
On Local Error GoTo Err_AbreArchivo
Dim CDlg As CommonDialog
Set CDlg = New CommonDialog
Dim sArchivo As String
CDlg.Filename = ""
CDlg.Filter = "Imágenes JPG (*.JPG)|*.JPG|Imágenes GIF (*.GIF)|*.GIF"
CDlg.DialogTitle = "Seleccione la imagen que desea copiar"
If Trim(sRuta) = "" Then
CDlg.InitDir = "C:\"
Else
CDlg.InitDir = sRuta
End If
CDlg.DefaultExt = "JPG"
CDlg.ShowOpen
sArchivo = CDlg.Filename
If sArchivo <> "" Then
If UCase(Right(sArchivo, 4)) <> ".JPG" And UCase(Right(sArchivo, 4)) <> ".GIF" Then
MsgBox "El archivo seleccionado (" & CDlg.FileTitle & ") NO es un archivo de Imagen valida", vbInformation, Application.Name
Else
sRuta = ActiveWorkbook.Path & "\Imágenes"
Set FSO = New FileSystemObject
If Not FSO.FolderExists(sRuta) Then FSO.CreateFolder sRuta
FSO.CopyFile sArchivo, sRuta & "\Imagen1" & Right(sArchivo, 4)
Set FSO = Nothing
End If
End If
Exit_AbreArchivo:
Exit Sub
Err_AbreArchivo:
MsgBox Err.Description, vbInformation, Application.Name
Resume Exit_AbreArchivo
End Sub
Private Sub CommandButton1_Click()
AbreArchivo
End Sub
Te dejo este código a ver si te es de utilidad.
De cualquier modo re puedo enviar el ejemplo a tu correo.
Option Explicit
Public sRuta As String
Public FSO As FileSystemObject
Sub AbreArchivo()
On Local Error GoTo Err_AbreArchivo
Dim CDlg As CommonDialog
Set CDlg = New CommonDialog
Dim sArchivo As String
CDlg.Filename = ""
CDlg.Filter = "Imágenes JPG (*.JPG)|*.JPG|Imágenes GIF (*.GIF)|*.GIF"
CDlg.DialogTitle = "Seleccione la imagen que desea copiar"
If Trim(sRuta) = "" Then
CDlg.InitDir = "C:\"
Else
CDlg.InitDir = sRuta
End If
CDlg.DefaultExt = "JPG"
CDlg.ShowOpen
sArchivo = CDlg.Filename
If sArchivo <> "" Then
If UCase(Right(sArchivo, 4)) <> ".JPG" And UCase(Right(sArchivo, 4)) <> ".GIF" Then
MsgBox "El archivo seleccionado (" & CDlg.FileTitle & ") NO es un archivo de Imagen valida", vbInformation, Application.Name
Else
sRuta = ActiveWorkbook.Path & "\Imágenes"
Set FSO = New FileSystemObject
If Not FSO.FolderExists(sRuta) Then FSO.CreateFolder sRuta
FSO.CopyFile sArchivo, sRuta & "\Imagen1" & Right(sArchivo, 4)
Set FSO = Nothing
End If
End If
Exit_AbreArchivo:
Exit Sub
Err_AbreArchivo:
MsgBox Err.Description, vbInformation, Application.Name
Resume Exit_AbreArchivo
End Sub
Private Sub CommandButton1_Click()
AbreArchivo
End Sub
