Jump to content

OPTIMIZAR BUSQUEDA DE ARCHIVOS CON MACRO (Cambio de For each)


Go to solution Solved by Héctor Miguel,

Recommended Posts

Hola a todos muy buenos dias como estan! 

A los grandes maestros de este grupo, queria consultar por una macro que estoy usando para buscar archivos en una  carpeta, actualmente la macro me funciona, recorre todos los archivos dentro de una carpeta pero no que no logre es que si hay subcarpetas entre tambien a las sub carpetas, asi que tengo que hacerlo uno por uno

aun asi seleccionando carpeta por carpeta, es muy muy muy lento🐢.... demora 11 minutos en ejecutarse para evaluar por ejemplo una carpeta con 600 archivos... 

me gustaria saber si existe o no una forma de optimizar para que demore menos... porque lo que necesito es evaluar MUUUUCHAS CARPETAS con esa cantidad de contenio o mas.... y voy a demorar la vida... 

pero bueno, no se si es posible o no... quizas estaba pensando que si aplico un filtro para que solo me traiga los arhivos de imagen o video, (aunque la carpeta que me duro esa cantidad de tiempo tenia solo imagenes), no se si es el uso del for each lo que hace que sea tan lenta... o si son las formulas que le puse que use con la grabadora de macros: que son de dividir columnas, y de buscar en otra hoja otros datos... 

podrian ayudarme a optimizarla por favor? o decirme si es imposible ? 😰por favor o si tengo que llegar a la jubilacion 👵 para evaluarlas a todas  jajaja

Tambien pregunto, por las dudas , si es posible mejorar la busqueda, para que no tenga que entrar carpeta por carpeta y pueda incluir la busqueda dentro de subcarpetas?

 

les comparto el codigo y el archivo, el codigo lo estoy ejecutando en el userform al presionar el boton buscar carpeta...

millones de gracias de antemano a todas las personas que son parte de comunidad  que tengas todos un lindo dia!

 

Private Sub FVBuscarFotosEtiquetas_Click()


tiempo = Now


'Declaramos variables
Dim FSO As Object, directorio As String
Dim dir_Archivo As Variant
Dim WS As Worksheet
Dim i As Long
Dim FolderPath As String
Dim objShell, objFolder, objFolderItem As Object
Dim oFolder, oFile As Object

 'Abrimos ventana de diálogo para seleccionar carpeta
Set dir_Archivo = application.FileDialog(msoFileDialogFolderPicker)
    dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
        Exit Sub
        End If
'Capturamos el directorio del archivo seleccionado
directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set FSO = CreateObject("Scripting.FileSystemObject")
'GetFileAttributes FSO.GetFolder(Directorio)

application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application") 'D:\PAULA\yaguarete\Jaguar tracker\album tigres
FolderPath = directorio '"E:\Yaboti 2021\Aguante Brpy36 14-08-21 E" '"G:\Till\0262529629\" 'Set folderpath

Set WS = ActiveWorkbook.Worksheets("FotosEtiquetadas") 'Set sheet name

'WS.Range("A1:O1").Value = Array("URLArchivo", "NombredeArchivo", "Estacion", "Fecha Captura", "Hora", "NombreImagen", "Fecha Importacion", "TipoArchivo", "Tamaño", "PercepcionTipoArchivo", "Etiquetas o Tags", "Sitio", "Estacion", "Especie", "Observaciones")

Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.getfolder(FolderPath)

i = application.CountA(WS.Range("A:A")) + 1 'First row to print result


Dim nombrev As String
Dim repeticiones As Integer

 
nombrev = oFolder

repeticiones = WorksheetFunction.CountIfs(Range("Ae:Ae"), nombrev)

If repeticiones > 0 Then
MsgBox "La Carpeta ' " & oFolder & " ' ya se encuentra cargada en el sistema.", vbExclamation
Else

For Each oFile In oFolder.Files


On Error Resume Next 'If any attribute is not retrievable ignore and continue
    Set objFolder = objShell.Namespace(oFolder.Path)
    Set objFolderItem = objFolder.ParseName(oFile.Name)
    
    ' etiquetas del archivo o file -----------------------------------------------------------------------
    WS.Cells(i, 1).Value = objFolder.GetDetailsOf(objFolderItem, 0) 'nombre del archiv
    WS.Cells(i, 2).Value = "=IFERROR(VLOOKUP(CONCAT(RC[3],""-"",RC[1]),'RefEstaciones-Sitios'!C[1]:C[4],4,FALSE),"""")"
    ' Obtención elementos del ID -------------------------------------------------------------------------
    WS.Cells(i, 3).Value = "=@ExtraeDato(""A"",RC[+27])"  'sitio
    'WS.Cells(i, 4).Value = "" 'Muestreo Sistemtico
    WS.Cells(i, 5).Value = "=SepararEnColumnas(RC[-4], 1, "" "")" 'Estacion
    WS.Cells(i, 6).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-1],""-"",RC[-3]),'RefEstaciones-Sitios'!C[-3]:C[-1],2,FALSE),"""")" 'Latitud
    WS.Cells(i, 7).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-2],""-"",RC[-4]),'RefEstaciones-Sitios'!C[-4]:C[-2],3,FALSE),"""")" 'Longitud
    WS.Cells(i, 8).Value = "=IFERROR(SepararEnColumnas(RC[-7], 2, "" ""),"""")" 'FechaCaptura
    WS.Cells(i, 9).Value = "=IFERROR(SepararEnColumnas(RC[-8], 3, "" ""),"" "")" 'Hora
    WS.Cells(i, 10).Value = "=@ExtraeDato(""C"",RC[+20])" 'Especie
    'WS.Cells(i, 11).Value = "" 'Independizator
    
    ' ------------------------------------------------------------------------------------------------------
    
    'keywords o Tags importados Bridge --------------------------------------------------------------------
    WS.Cells(i, 12).Value = "" ' tipo de Registro
    WS.Cells(i, 13).Value = "=@ExtraeDato(""D"",RC[+17])" 'Observaciones
    WS.Cells(i, 14).Value = "=@ExtraeDato(""F"",RC[+16])" 'etiqueta yaguarete flanco
    WS.Cells(i, 15).Value = "=@ExtraeDato(""G"",RC[+15])"  'etiqueta yaguarete sexo
    WS.Cells(i, 16).Value = "=@ExtraeDato(""H"",RC[+14])"  'etiqueta yaguarete edad
    WS.Cells(i, 17).Value = "=@ExtraeDato(""I"",RC[+13])" 'etiqueta yaguarete id Individuo
    '
    
    'etiquetas yaguarete------------------------------------------------------------------------------------
    'WS.Cells(i, 18).Value = "" 'Identificador del Registro
    'WS.Cells(i, 19).Value = "" 'usuario que creo el registro
    'WS.Cells(i, 20).Value = ""  'Responsable del Registro
    'WS.Cells(i, 21).Value = ""  'Institucion
    'WS.Cells(i, 22).Value = ""  'uso libre o reservado
    'WS.Cells(i, 23).Value = ""  'uso de la imagen
    'WS.Cells(i, 24).Value = ""  'observaciones
    'WS.Cells(i, 25).Value = ""  'vivo o muerto
    'WS.Cells(i, 26).Value = ""  'animal problema capturado o muerto
    WS.Cells(i, 27).Value = "=HYPERLINK(CONCAT(RC[+4],""/"",RC[+12]))"
    '
    'Enviar al Fondo otros datos-------------------------------------------------------------
    WS.Cells(i, 30).Value = objFolder.GetDetailsOf(objFolderItem, 18) ' Keywords o Tags
    WS.Cells(i, 31).Value = oFolder.Path 'Folder Path
    WS.Cells(i, 32).Value = CDate(objFolder.GetDetailsOf(objFolderItem, 5)) 'Fecha Importacion
    WS.Cells(i, 33).Value = objFolder.GetDetailsOf(objFolderItem, 1) ' Tamaño
    WS.Cells(i, 34).Value = objFolder.GetDetailsOf(objFolderItem, 164) ' extension
    WS.Cells(i, 35).Value = objFolder.GetDetailsOf(objFolderItem, 12) ' Percepcion tipo Archivo
    WS.Cells(i, 36).Value = objFolder.GetDetailsOf(objFolderItem, 30) ' Modelo Camara
    WS.Cells(i, 37).Value = objFolder.GetDetailsOf(objFolderItem, 32) 'Fabricante Camara
    WS.Cells(i, 38).Value = objFolder.GetDetailsOf(objFolderItem, 190) 'nombre folder
    WS.Cells(i, 39).Value = oFile.Name 'url
    
   
    i = i + 1
    
    
Call cargadatos_ListaArchivos
 
On Error Resume Next

Next
End If

 
application.ScreenUpdating = False
tiempo = datediff("s", tiempo, Now)

MsgBox "La macro dura" & (tiempo)
Unload Me

End Sub

 

PruebaOptimizar.xlsm

Link to comment
Share on other sites

hice otra prueba con una carpeta de 800 archivos y demoro mas de 15 ... 😭  😭  😭  😭 quiero llorar! 

Link to comment
Share on other sites

Hace 51 minutos , JSDJSD dijo:

Hola @JSDJSD buen dia!

Muchisimas gracias lista muy rapidamente en cuestion de segundos el listado de archivos dentro de las carpetas y sub carpetas, pero cuando quiero extrar los datos de cada archivo dentro de carpetas y subcarpetas, ahora ya no me funciona... 

Aqui te muestro como añadi la otra parte del codigo que trae los datos que obtiene de .GetDetailsOf, quiza lo estoy aplicando mal, podrias ayudarme a como entrar a esos datos con el codigo super mega optimizado que me pasaste?

 

Te lo re agradeceria! muchisiimas gracias!

Sub Mostrar_Archivos(Ruta): Application.ScreenUpdating = False

    'Sección 1: Declaración de variables y objetos
    Dim fila As Long
    Dim fs, carpeta, archivo, subcarpeta As Object
    Set fs = CreateObject("Scripting.FileSystemObject")

    'Sección 2: Ajustes necesarios a ruta
    If Ruta = "" Then
        Exit Sub
    ElseIf Right(Ruta, 1) <> "\" Then
        Ruta = Ruta & "\"
    End If
    
    'Sección 3: Objeto Folder de la ruta indicada
    On Error GoTo ErrHandler
    Set carpeta = fs.GetFolder(Ruta)
    
    'Sección 4: Obtener archivos del objeto Folder
    fila = 4
    For Each archivo In carpeta.Files
        Hoja1.Cells(fila, 1) = Ruta & archivo.Name
        fila = fila + 1
    Next
    
    'Sección 5: Obtener subcarpetas del objeto Folder
    For Each subcarpeta In carpeta.SubFolders
        Mostrar_Archivos (subcarpeta)
        For Each oFile In carpeta.SubFolders


On Error Resume Next 'If any attribute is not retrievable ignore and continue
    Set objFolder = objShell.Namespace(oFolder.Path)
    Set objFolderItem = objFolder.ParseName(oFile.Name)
    
    ' etiquetas del archivo o file -----------------------------------------------------------------------
    WS.Cells(i, 1).Value = objFolder.GetDetailsOf(objFolderItem, 0) 'nombre del archiv
    WS.Cells(i, 2).Value = "=IFERROR(VLOOKUP(CONCAT(RC[3],""-"",RC[1]),'RefEstaciones-Sitios'!C[1]:C[4],4,FALSE),"""")"
    ' Obtención elementos del ID -------------------------------------------------------------------------
    WS.Cells(i, 3).Value = "=@ExtraeDato(""A"",RC[+27])"  'sitio
    'WS.Cells(i, 4).Value = "" 'Muestreo Sistemtico
    WS.Cells(i, 5).Value = "=SepararEnColumnas(RC[-4], 1, "" "")" 'Estacion
    WS.Cells(i, 6).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-1],""-"",RC[-3]),'RefEstaciones-Sitios'!C[-3]:C[-1],2,FALSE),"""")" 'Latitud
    WS.Cells(i, 7).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-2],""-"",RC[-4]),'RefEstaciones-Sitios'!C[-4]:C[-2],3,FALSE),"""")" 'Longitud
    WS.Cells(i, 8).Value = "=IFERROR(SepararEnColumnas(RC[-7], 2, "" ""),"""")" 'FechaCaptura
    WS.Cells(i, 9).Value = "=IFERROR(SepararEnColumnas(RC[-8], 3, "" ""),"" "")" 'Hora
    WS.Cells(i, 10).Value = "=@ExtraeDato(""C"",RC[+20])" 'Especie
    'WS.Cells(i, 11).Value = "" 'Independizator
    
    ' ------------------------------------------------------------------------------------------------------
    
    'keywords o Tags importados Bridge --------------------------------------------------------------------
    WS.Cells(i, 12).Value = "" ' tipo de Registro
    WS.Cells(i, 13).Value = "=@ExtraeDato(""D"",RC[+17])" 'Observaciones
    WS.Cells(i, 14).Value = "=@ExtraeDato(""F"",RC[+16])" 'etiqueta yaguarete flanco
    WS.Cells(i, 15).Value = "=@ExtraeDato(""G"",RC[+15])"  'etiqueta yaguarete sexo
    WS.Cells(i, 16).Value = "=@ExtraeDato(""H"",RC[+14])"  'etiqueta yaguarete edad
    WS.Cells(i, 17).Value = "=@ExtraeDato(""I"",RC[+13])" 'etiqueta yaguarete id Individuo
    '
    
    'etiquetas yaguarete------------------------------------------------------------------------------------
    'WS.Cells(i, 18).Value = "" 'Identificador del Registro
    'WS.Cells(i, 19).Value = "" 'usuario que creo el registro
    'WS.Cells(i, 20).Value = ""  'Responsable del Registro
    'WS.Cells(i, 21).Value = ""  'Institucion
    'WS.Cells(i, 22).Value = ""  'uso libre o reservado
    'WS.Cells(i, 23).Value = ""  'uso de la imagen
    'WS.Cells(i, 24).Value = ""  'observaciones
    'WS.Cells(i, 25).Value = ""  'vivo o muerto
    'WS.Cells(i, 26).Value = ""  'animal problema capturado o muerto
    WS.Cells(i, 27).Value = "=HYPERLINK(CONCAT(RC[+4],""/"",RC[+12]))"
    '
    'Enviar al Fondo otros datos-------------------------------------------------------------
    WS.Cells(i, 30).Value = objFolder.GetDetailsOf(objFolderItem, 18) ' Keywords o Tags
    WS.Cells(i, 31).Value = oFolder.Path 'Folder Path
    WS.Cells(i, 32).Value = CDate(objFolder.GetDetailsOf(objFolderItem, 5)) 'Fecha Importacion
    WS.Cells(i, 33).Value = objFolder.GetDetailsOf(objFolderItem, 1) ' Tamaño
    WS.Cells(i, 34).Value = objFolder.GetDetailsOf(objFolderItem, 164) ' extension
    WS.Cells(i, 35).Value = objFolder.GetDetailsOf(objFolderItem, 12) ' Percepcion tipo Archivo
    WS.Cells(i, 36).Value = objFolder.GetDetailsOf(objFolderItem, 30) ' Modelo Camara
    WS.Cells(i, 37).Value = objFolder.GetDetailsOf(objFolderItem, 32) 'Fabricante Camara
    WS.Cells(i, 38).Value = objFolder.GetDetailsOf(objFolderItem, 190) 'nombre folder
    WS.Cells(i, 39).Value = oFile.Name 'url
    
   
    i = i + 1
    Next
    
    'Sección 6: Auto-ajustar columnas y salir
    ActiveCell.EntireColumn.AutoFit
    Exit Sub
    
ErrHandler:
    ActiveCell.Value = "Ruta inexistente"

End Sub

 

Link to comment
Share on other sites

Lo que hacia antes con codigo super lento  es recorrer  cada archivo dentro de la carpeta y obtener por medio de .getdetails otros metadatos como ser Tags o Keywords, fecha de creacion, nombre de la carpeta, nombre de la camara, fabricante, extension del archivo entre otros datos,

Asu vez en el mismo proceso, se hacian divisiones en columna ...por ejemplo:  

WS.Cells(i, 5).Value = "=SepararEnColumnas(RC[-4], 1, "" "")" 'Estacion

tomaba el dato del nombre del archivo y lo dividia en columnas por delimitador.

Tambien se concatenaban dos columnas y se aplicaba la formula buscarv para traer los datos de longitud y latitud de la hoja ref estaciones:

 WS.Cells(i, 6).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-1],""-"",RC[-3]),'RefEstaciones-Sitios'!C[-3]:C[-1],2,FALSE),"""")" 'Latitud
    WS.Cells(i, 7).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-2],""-"",RC[-4]),'RefEstaciones-Sitios'!C[-4]:C[-2],3,FALSE),"""")" 'Longitud

Por otro lado se separaban tambien la fecha de la hora,  y se extraian datos de las columna que guardaba los tags o keyword en otra columna:

WS.Cells(i, 30).Value = objFolder.GetDetailsOf(objFolderItem, 18) ' Keywords o Tags
WS.Cells(i, 10).Value = "=@ExtraeDato(""C"",RC[+20])" 'Especie

pero todos estos procesos los hacia dentro del for each que recorria archivo por archivo, dentro de la carpeta... de manera claro hiper lenta..

Ahora tu codigo hace magia, y lista super rapido los archivos, pero no logro que me saque esa informacion como lo hacia antes de cada archivo el .getdetails no me funciona ahora con tu codigo y no logro entender porque...

 

en cuanto a lo que deberia hacer es :

1- recorrer carpeta por carpeta y sub carpetas /esto ya esta en perfecto 

2- listar todos los archivos y obtener de cada uno esa informacion detallada. 

3 luego aplicar quizar las formulas que ya tenia de buscarv, extraer datos y dividir columnas 

me faltaria me vuelva a funcionar los pasos 2 y 3... que no entiendo porque ahora no andan

 

 

 

Link to comment
Share on other sites

Hace 1 hora, JSDJSD dijo:

Una vez listados todos los archivos de carpetas y su carpetas que quieres hacer ?

Lo que hacia antes con codigo super lento  es recorrer  cada archivo dentro de la carpeta y obtener por medio de .getdetails otros metadatos como ser Tags o Keywords, fecha de creacion, nombre de la carpeta, nombre de la camara, fabricante, extension del archivo entre otros datos,

Asu vez en el mismo proceso, se hacian divisiones en columna ...por ejemplo:  

WS.Cells(i, 5).Value = "=SepararEnColumnas(RC[-4], 1, "" "")" 'Estacion

tomaba el dato del nombre del archivo y lo dividia en columnas por delimitador.

Tambien se concatenaban dos columnas y se aplicaba la formula buscarv para traer los datos de longitud y latitud de la hoja ref estaciones:

 WS.Cells(i, 6).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-1],""-"",RC[-3]),'RefEstaciones-Sitios'!C[-3]:C[-1],2,FALSE),"""")" 'Latitud
    WS.Cells(i, 7).Value = "=IFERROR(VLOOKUP(CONCAT(RC[-2],""-"",RC[-4]),'RefEstaciones-Sitios'!C[-4]:C[-2],3,FALSE),"""")" 'Longitud

Por otro lado se separaban tambien la fecha de la hora,  y se extraian datos de las columna que guardaba los tags o keyword en otra columna:

WS.Cells(i, 30).Value = objFolder.GetDetailsOf(objFolderItem, 18) ' Keywords o Tags
WS.Cells(i, 10).Value = "=@ExtraeDato(""C"",RC[+20])" 'Especie

pero todos estos procesos los hacia dentro del for each que recorria archivo por archivo, dentro de la carpeta... de manera claro hiper lenta..

Ahora tu codigo hace magia, y lista super rapido los archivos, pero no logro que me saque esa informacion como lo hacia antes de cada archivo el .getdetails no me funciona ahora con tu codigo y no logro entender porque...

 

en cuanto a lo que deberia hacer es :

1- recorrer carpeta por carpeta y sub carpetas /esto ya esta en perfecto 

2- listar todos los archivos y obtener de cada uno esa informacion detallada. 

3 luego aplicar quizar las formulas que ya tenia de buscarv, extraer datos y dividir columnas 

me faltaria me vuelva a funcionar los pasos 2 y 3... que no entiendo porque ahora no andan

 

 

 

Link to comment
Share on other sites

Hace 2 horas, roa30 dijo:

no logro que me saque esa informacion como lo hacia antes de cada archivo el .getdetails

1) cuando se trata de analizar archivos desde una carpeta de base y continuar con todas sus (sub)(sub)(sub)carpetas
- usar un objeto fso resulta ser el mas ineficiente de los métodos actualmente
- además de que "hacer mas cosillas" ARCHIVO-POR-ARCHIVO...
- (perdida de tiempo, si hay otras formas y métodos como en la muestra del adjunto)
- OJO: si en la ruta (hasta el nombre del archivo) existen caracteres tildados (?) hay que dar unas "vueltas de tuerca"

2) para obtener los detalles extendidos (atributos)
- busca por la web los índices del atributo que necesitas (algunos los tienes equivocados)

3) por los demás datos y extracciones que utilizas en la muestra de tu adjunto
- (te los dejo de tarea ?)

prueba con la muestra del adjunto, => la ruta la pones en la celda [A1]
- si quieres aplicar cualquier otro mecanismo  de buscar la carpeta de inicio (be my guest)
- OJO: NO pongas el separador de rutas al final de la carpeta de base

si no localizas la lista de índices para los atributos del ".GetDetailsOf" (comentas ?)

list Files from Folders (ayudaExcel).xlsm

Link to comment
Share on other sites

Hace 1 hora, Héctor Miguel dijo:

1) cuando se trata de analizar archivos desde una carpeta de base y continuar con todas sus (sub)(sub)(sub)carpetas
- usar un objeto fso resulta ser el mas ineficiente de los métodos actualmente
- además de que "hacer mas cosillas" ARCHIVO-POR-ARCHIVO...
- (perdida de tiempo, si hay otras formas y métodos como en la muestra del adjunto)
- OJO: si en la ruta (hasta el nombre del archivo) existen caracteres tildados (?) hay que dar unas "vueltas de tuerca"

2) para obtener los detalles extendidos (atributos)
- busca por la web los índices del atributo que necesitas (algunos los tienes equivocados)

3) por los demás datos y extracciones que utilizas en la muestra de tu adjunto
- (te los dejo de tarea ?)

prueba con la muestra del adjunto, => la ruta la pones en la celda [A1]
- si quieres aplicar cualquier otro mecanismo  de buscar la carpeta de inicio (be my guest)
- OJO: NO pongas el separador de rutas al final de la carpeta de base

si no localizas la lista de índices para los atributos del ".GetDetailsOf" (comentas ?)

list Files from Folders (ayudaExcel).xlsm 14.56 kB · 1 descarga

Hola Héctor Miguel! como estas un gusto! 

woww probé con mi carpeta de 600 archivos y funciono en milésimas de segundos... 🤗

veo que es super pro tu código y yo soy re principiante por eso hago los pasos de forma muy declarativa y entiendo que asi es super lento y lo veo que es así, no hay como negarlo!

2) sobre atributos. Por los atributos los tengo, encontré una lista que trae 320.... pero ...... justo ahora me he partido la cabeza porque hay ciertos atributos que "XmpToolkit" 😰 que no aparecen por ningún lado y encontré el exiftool que por medio de comando cmd se puede hacer ahora estoy investigando como llevarlo a mi proyecto de vba, para que sea mas fácil a los colaboradores del proyecto. Prometo compartilos los resultados si lo llego a lograr... (pero bueno esto es mas que nada para videos, porque las etiquetas que se añaden a las fotos si se pueden ver con el getdetails, pero las de video no, es como que están escondidas.... 😭 pero bueno pese a ello....sigamos

3) me animo si a intentarlo pero no entiendo en la forma que esta escrito el código como ir poniéndolo me podrías mostrar una sola linea por ejemplo como

la tarea de dividir columnas por delimitador que me ayudo @Antoni, que usaba una funcion personalizada para la columna de las etiquetas o tags, que en el archivo que me pasaste estan la columna "C"

Esta es la funcion de @Antonique funcionaba perfecto

Public Function ExtraeDato(Dato As String, Texto As String) As String
On Error Resume Next
If Texto = "" Then Exit Function
Datos = Split(Texto, ";")
Select Case Dato
   Case "A": i = 0
   Case "B": i = 1
   Case "C": i = 2
   Case "D": i = 3
   Case "E": i = 4
   Case "F": i = 5
   Case "G": i = 6
   Case "H": i = 7
   Case "I": i = 8 ' Uso Imagen: para ID, difusión, sin interes.
   Case "J": i = 9 'Muerto o Vivo"
   Case "K": i = 10 'Observaciones 2
   
 
End Select
ExtraeDato = Split(Datos(i), "|")(1)
End Function

Y yo lo que hacia era tomar esa funcion personalizada con la grabadora de macros y ponerla en la hoja, para que por cada TAG o  Etiqueta me separare en sus respectivas columnas,  asi
WS.Cells(i, 10).Value = "=@ExtraeDato(""C"",RC[+20])" 'Especie 

Y no se donde poner esto ahora en el codigo para que me haga esas cosas cuando recorre un por uno... si me pudieras mostrar una sola linea, yo me animo a intentar sacarlas de alguna forma a las demas... podrias ayudarme por favor?

Link to comment
Share on other sites

Hace 3 horas, roa30 dijo:

justo ahora me he partido la cabeza porque hay ciertos atributos ... que no aparecen por ningún lado y encontré el exiftool que por medio de comando cmd se puede hacer ahora estoy investigando como llevarlo a mi proyecto de vba

para rescatar los datos de imágenes tomadas desde dispositivos con GPS (como latitud, longitud, etc.) hay que usar otros medios (y hacer algunas adecuaciones, pero...) todo lo que necesitas saber lo encuentras:

AQUI

y si compartes 3 o 4 imágenes que contengan los datos que buscas y una muestra de lo que esperas como "el resultado"... (igual y alguien se anima a terminarlo ?)

Link to comment
Share on other sites

que genio @Héctor Miguel de las miles de paginas y documentaciones que estuve leyendo no la encontre a esa...

 

por otro lado nuestras camaras no registran ubicaciones gps, las obtenemos haciendo una busqueda del sitio (que es parte de una de las etiquetas, y usando una funcion buscar v, desde otra hoja que tenemos los datos de los sitios y su posicion gps, lo traemos a la planilla que estamos trabajando ahora. 

En los videos tmb hay tag o etiquetas de sitio, especie, estacion y observaciones, solo que no estan visibles, como pueden ver el archivo data que subi, tiene todos los datos que logre extraer de los archivos de formato video, cuyas etiquetas no se porque no estan visible a simple vista ni en las propiedades del archivo. Esto lo hice usando exiftool con un comando en cmd que no entiendo mucho pero SI me leyo esos datos... serias ideal poder hacer esto desde vba porque nuestros colaboradores no son programadores ni nada , sino que son personas voluntarias que como mucho manejan oficce no mas...

Aqui puse dos archivos VideoYfotos

pueden ver que si entran a las propiedades del video no van a ver toda la informacion, que si se logra sacar con el exiftool que se ejecuta con unos comandos en la consola del sistema, a no ser que se pueda manejar la consola del sistema desde algun boton o formulario en excel me es inviable usarlo con nuestros colaboradores... pero bueno esto lo veo dificil y casi imposible aun, aunque sigo leyendo y leyendo a ver si se encuentra una alternativa porque me va a llevar la vida terminarlo...

 y respecto a esto una muestra de lo que esperas como "el resultado"... (igual y alguien se anima a terminarlo ?)

adjunto "datos como resultado" que es el resultado original del archivo que adjunte cuando inicie el tema, solo que obtener todos esos datos con esa forma me demoro 15 minutos para una sola carpeta, y hasta ahi el codigo no entraba en las subcarpetas tampoco.... tu y @JSDJSD lo han hecho super mega rapido a la funcion de listar los archivos y obtener algunas de sus propiedades, lo que no logro es aplicar las formulas personalizadas ni las funciones que tenia antes para la division de colunmas y extraccion de datos...

 

y por ultimo aqui esta mi arvhivo original con el casi me jubilo que si aplicaba esas funciones y formulas pero que demoraban muchisimo en completar la tarea.PruebaOptimizar.xlsm

 

 

 

 

data.csv datos como resultado.xlsx

Link to comment
Share on other sites

Hace 6 horas, roa30 dijo:

adjunto "datos como resultado" que es el resultado original del archivo que adjunte cuando inicie el tema

ok. déjame ver lo que puedo hacer (con lo del exiftool) y como evito los cálculos "forward" (celdas con formulas cuyo resultado depende de celdas mas a la derecha -o abajo-)

importa si te cambio el orden de algunas columnas ?

Hace 12 horas, JSDJSD dijo:

sigue los consejos de...

te agradeceré (infinitamente) si "me quitas al 'maestro' de encima", solo soy...

uno mas de los entusiastas de excel (o...)

uno de los mas entusiastas de excel 🤔

Link to comment
Share on other sites

Hace 9 minutos , Héctor Miguel dijo:

déjame ver lo que puedo hacer (con lo del exiftool)

no me gustan las advertencias para la instalacion de exiftool (voy a ver si puedo amortiguar)

Link to comment
Share on other sites

 

Hace 5 horas, Héctor Miguel dijo:

ok. déjame ver lo que puedo hacer (con lo del exiftool) y como evito los cálculos "forward" (celdas con formulas cuyo resultado depende de celdas mas a la derecha -o abajo-)

importa si te cambio el orden de algunas columnas ?

te agradeceré (infinitamente) si "me quitas al 'maestro' de encima", solo soy...

uno mas de los entusiastas de excel (o...)

uno de los mas entusiastas de excel 🤔

Hola héctor miguel! tienes toda la razon.. y yo soy parecida a ti, solo que una apasionada de los datos...🙂 y en ese camino descubri todo el potencial de excel, y me encanto!!! admiro a la gente como tu , por la capacidad que tienen, y que algun dia espero lograr ir desarrollando...

los comandos en cmd no los entiendo mucho todavia y la verdad que excel tiene una ventaja muy importante es muy amigable para cualquier usuario...

Cita

importa si te cambio el orden de algunas columnas ?

no no por favor para nada, el orden no es importante si no que puedan estar todas esas variables nada mas

Link to comment
Share on other sites

Hace 5 horas, Héctor Miguel dijo:

no me gustan las advertencias para la instalacion de exiftool (voy a ver si puedo amortiguar)

a mi tampoco no me gusto, pero no encontre otra herramienta, es la unica que obtiene todos los datos realmente, e incluisive en los archivos de video, tomar los datos de los tags o etiquetas o keywords, en una parte que la evaluan como xmp toolkit.

 

Para las fotos, con los que me estan ayudando casi lo tendriamos, y esto de los videos parece complejo he intentado hacerlo desde vba asi y solo logro que me ejecute y me abra la consola de la terminal pero no me escribi el comando 

C:\ExifToolC>Exiftool.exe -lang es -csv -r "c:\ExifToolC\Abierto O20 3-11-20 E">  dataprueba.csv

esto si lo escribo en la terminal me lee todos los datos carpetas y subcarpetas y me lleva toda esa informacion a un nuevo archivo que lo crea en la misma carpeta... en este caso le asigne el nombre dataprueba.cvs

para abrir la consola en excel use:

ret = Shell("cmd /k " & C:\ExifToolC>Exiftool.exe -lang es -csv -r "c:\ExifToolC\Abierto O20 3-11-20 E">  dataprueba.csv, vbNormalFocus)

Link to comment
Share on other sites

Hace 10 horas, roa30 dijo:

a mi tampoco no me gusto, pero no encontre otra herramienta, es la unica que obtiene todos los datos

1) los datos que obtienes con ExifTool (archivo *.csv) son 38 columnas/conceptos, pero no todos están en tu libro de muestra
- cuales son (exactamente) los que necesitas incorporar a tu reporte ? (y algún orden en especial ?)
- toma en cuenta que al abrir el *.csv (en excel) se cargan 23 encabezados/títulos
- pero el ultimo (parece que) contiene varios mas (exceso de caracteres " ; ")
- igual pasa con algunos "registros" (columnas en fila) hasta la columna 38 (ver el punto 3)
- OJO: esto sin mencionar caracteres tildados (que pasan como caracteres extendidos, p.ej. "Estándar" pasa como "Estándar")

2) asumo que el sistema donde se genera ese *.csv utiliza " ; " (punto y coma) como separador de listas (y argumentos en las funciones de excel)
- tienes la certeza de que esa configuración regional será la misma para todos los equipos, usuarios y casos ?

3) algunos títulos (en ese *.csv) están "cortados" por ese caracteer ( ; ) en varias "secciones"
- p.ej. si cuentas los caracteres ( ; ) en los registros vacíos existen 89 "secciones" (NO las 38 columnas)
- ya tienes resuelto este tema para no "cortar" (también) los títulos "en partes" ?

4) el orden de los encabezados/títulos (en tu muestra original) no coincide en algunas partes con el "dato rescatado", p.ej.
- columna "AH", concepto "EXIFDatos- Size" > el dato anotado es el "tipo" (.jpg)
- el dato real de fecha lo tienes en la columna "AL" (entre otras diferencias)
- y algunos títulos (parece que) están repetidos (no se debiera reportar solo uno por "tipo" ?)

quiero confiar en los datos que vuelca la herramienta (ExifTool) aun pasando por un *.csv (pero los puntos anteriores "me hacen ruido") antes de decidirme por instalar y probar

entiendo que dicha herramienta puede analizar todos los archivos de una carpeta, pero... puede ciclar entre (sub)(sub)(sub)carpetas ?

aquí el detalle/problema pudiera ser el orden en que se rescatan los archivos (en el reporte) y el orden en que los analiza la herramienta, a menos que para el reporte se analicen uno por uno (?)

Link to comment
Share on other sites

1) los datos que obtienes con ExifTool (archivo *.csv) son 38 columnas/conceptos, pero no todos están en tu libro de muestra
- cuales son (exactamente) los que necesitas incorporar a tu reporte ? (y algún orden en especial ?)
- toma en cuenta que al abrir el *.csv (en excel) se cargan 23 encabezados/títulos

Hola Hector Miguel, como estas? 🙂

No se que tiene este exiftool.exe, que se me borra de un dia para el otro del directorio y tengo que volver a ponerlo para que funcione... 🤨... definitivamente me quedo con excel toda la vida🤭...

Mira volvi a  hacer una extraccion de datos de un archivo de tipo etiquetas con exiftool , y te lo adjunto como csv....de los video lo unico que necesito sacar de dato es la colunma que dice : Colunma AL => "HierarchicalSubject" (cuyo contenido se muestra asi) A.Sitio|San jorge, B.Estacion|Alcostado, C.Especie|Cerdocyon thous, D.Observaciones|2 ind.

Todos los otros datos no los necesito sacar con exift, porque los podemos obtener con el .getdetails con el procedimiento que usamos para las fotos.

La verdad que no requerimos un orden especial, pero deberiamos lograr poner ese dato "HierarchicalSubject (
A.Sitio|San jorge, B.Estacion|Alcostado, C.Especie|Cerdocyon thous, D.Observaciones|2 ind.) en la misma planilla donde estan las fotos y en la misma colunma donde estan esas etiquetas, para luego hacer el split...

En sintesis deberia poder usar la misma planilla para arhivos de imagen o videos... capaz si logramos sacar ese dato solamente, luego necesite ponerle antes algun condicional en la extension o tipo de arhivo ... eje: si es foto, hacer esto, si es video (el otro procedimiento que obtenga HierarchicalSubject
de los videos.

2) asumo que el sistema donde se genera ese *.csv utiliza " ; " (punto y coma) como separador de listas (y argumentos en las funciones de excel)
- tienes la certeza de que esa configuración regional será la misma para todos los equipos, usuarios y casos ?

Use el exiftool para extraer los datos que estan en el csv usando estos comandos en la consola de la terminal:
C:\exiftoolverson2> exiftool.exe  -r -csv "c:\exiftoolverson2\Abierto O20 3-11-20 E\100RECNX\nEU"> solovideos.csv
    1 directories scanned
    2 image files read

por lo que lei, se pueden extraer en csv, html, y txt, yo le puse que exporte en csv porque me parecio que podia ser mas facil llevarlo al proyecvo de excel.

Hace 1 hora, Héctor Miguel dijo:

3) algunos títulos (en ese *.csv) están "cortados" por ese caracteer ( ; ) en varias "secciones"
- p.ej. si cuentas los caracteres ( ; ) en los registros vacíos existen 89 "secciones" (NO las 38 columnas)
- ya tienes resuelto este tema para no "cortar" (también) los títulos "en partes" ?

Respecto a esto, los titulos no me interesan, podria ser quizas necesario para ubicar el dato concreto  de la columna HierarchicalSubject, pero para nada mas, porque la carga de ese dato igual deberia ir a la misma planilla donde listamos todos los archivos fotos y videos y ponemos todos sus atributos.

Hace 1 hora, Héctor Miguel dijo:

4) el orden de los encabezados/títulos (en tu muestra original) no coincide en algunas partes con el "dato rescatado", p.ej.
- columna "AH", concepto "EXIFDatos- Size" > el dato anotado es el "tipo" (.jpg)
- el dato real de fecha lo tienes en la columna "AL" (entre otras diferencias)
- y algunos títulos (parece que) están repetidos (no se debiera reportar solo uno por "tipo" ?)

Claro aqui tienes razon, pero estaban mal porque habia agregado unos datos y se me corrieron: 

ID DEL REGISTRO
PROVINCIA
SITIO
MUESTREO SISTEMICO
ESTACION
LATITUD
LONGITUD
FECHA
HORA
ESPECIE
REGISTRO INDEPENDIENTE
TIPO DE REGISTRO
OBSERVACIONES
flanco
sexo
edad
individuo
IDENTIFICADOR DEL REGISTRO
USUARIO QUE CREO EL REGISTRO EN SISTEMA
Responsable del registro (Propiedad Dato)
institucion
Uso libre o reservado
Uso de la imagen (I)
Observación (K)
Muerto o vivo (J)
Animal problema, capturado o muerto
Link a la foto
EXIFDatos- Keywords /ACA VAN LOS TAGS O ETIQUETAS ANTES DEL SPLIT SEAN DE VIDEOS O FOTOS
EXIFDatos- Folder
EXIFDatos- FechaImportancion
EXIFDatos- Size
EXIFDatos- Extension
EXIFDatos- DateCaptura
EXIFDatos- ModeloCamara
EXIFDatos- FabricanteCamara
 

Estan serian las unicas colunmas que quedarian... sacando las repetidas.

Hace 1 hora, Héctor Miguel dijo:

entiendo que dicha herramienta puede analizar todos los archivos de una carpeta, pero... puede ciclar entre (sub)(sub)(sub)carpetas ?

Por lo que yo probe si lo hace, si antes de la ubicacion de la carpeta le agrego  -r al comando lee las carpetas, subcarpetas y archivos dentro de cada una.

Hace 1 hora, Héctor Miguel dijo:

aquí el detalle/problema pudiera ser el orden en que se rescatan los archivos (en el reporte) y el orden en que los analiza la herramienta, a menos que para el reporte se analicen uno por uno (?)

Si, puede que tengas razon, para mi el mayor problema que le veo es como evitar el uso complejo de la consola de la terminal, y poder hacer la extraccion del dato de las etiquetas de video, que es el " HierarchicalSubject" que no lo he podido sacar de ninguna otra forma. y luego como ponerlo en la misma hoja que ponemos los otros datos en la colunma adecuada.

1) por lo que yo veo, la lista de propiedades generales del getdetails, podemos hacer con todos los archivos (video y fotos) dentro de cada carpeta y sub carpeta archivo por archivo..

 2) ahora hay un dato que en los archivos de video no lo tenemos del getdetails, y tenemos que sacarlo de algun modo (ahora lo identificamos con el exiftool en HierarchicalSubject") y ponerlo en la columna del arvhivo orginal EXIFDatos- Keywords, para luego hacer las extracciones y split..

en esos dos puntos esta el problema... e implicito esta el problema del uso del exiftool que tampoco me convence..

 

 

solovideos.csv

Link to comment
Share on other sites

Hace 28 minutos , roa30 dijo:

Estan serian las unicas colunmas que quedarian... sacando las repetidas

ok, ya se ve mejor el arreglo final (ahora), de los 35 títulos que describes...
- enlista SOLO aquellos cuya informacion NO se obtiene de los datos de las imágenes o videos
- y comenta si el dato de esos conceptos es el usuario quien lo va a definir (supongo que no serán formulas ?)

(probablemente) convendría procesar en dos hojas, una para las fotos y otra para los videos
(o procesar en dos partes, primero fotos y luego videos ?)

Link to comment
Share on other sites

Posted (edited)
Hace 58 minutos , roa30 dijo:

implicito esta el problema del uso del exiftool que tampoco me convence

me "sacaste de onda" por segunda vez:

el primer *.csv que adjuntaste tiene como delimitador los dos puntos (y algunos intercalados)

este segundo *.csv usa como delimitador la coma

cual va a ser "el estándar" ?

Edited by Héctor Miguel
Link to comment
Share on other sites

Hace 7 minutos , Héctor Miguel dijo:

ok, ya se ve mejor el arreglo final (ahora), de los 35 títulos que describes...
- enlista SOLO aquellos cuya informacion NO se obtiene de los datos de las imágenes o videos
 

Claro esos serian los unicos datos: los 35 nombres de colunmas...

no entendi a que te refieres con " enlista solo aquellos ...." 

Lo que creo entender es que :

Paso Uno: se deberian listar todos los archivos de cada carpeta y subcarpeta con sus propiedades obtenidas del .getdetails eso cubriria los datos de algunas colunmas no de todas, porque hay varios que se obtienen de split, de formulas y de extraccion.

  • ID DEL REGISTRO = Se obtiene del nombre del archivo.
  • PROVINCIA= se obtiene de 1° la concantenacion de valor en las columnas "estacion y sitios " => quedando Asi = estacion-sitio. Esto se busca en la hoja "RefEstaciones-Sitios" de la columna C, se aplica la funcion BuscarV, que me trae el dato correspondiente a la Provincia de la columna "F" de la misma Hoja. 
  • SITIO = se extrae con un split y una division de texto en colunmas ... con la funcion que me ayudo a hacer @Antoni en el caso de Sitio se usa el caso "A".
  • Cita
    • ublic Function ExtraeDato(Dato As String, Texto As String) As String
      On Error Resume Next
      If Texto = "" Then Exit Function
      Datos = Split(Texto, ";")
      Select Case Dato
         Case "A": i = 0
         Case "B": i = 1
         Case "C": i = 2
         Case "D": i = 3
         Case "E": i = 4
         Case "F": i = 5
         Case "G": i = 6
         Case "H": i = 7
         Case "I": i = 8 ' Uso Imagen: para ID, difusión, sin interes.
         Case "J": i = 9 'Muerto o Vivo"
         Case "K": i = 10 'Observaciones 2
      
         
       
      End Select
      ExtraeDato = Split(Datos(i), "|")(1)
      End Function
  •  
  • MUESTREO SISTEMICO = Se completa de forma manual
  • ESTACION= lo mismo que sitio, solo que se usa el caso "B"
  • LATITUD= similar a provincia. se usa la funcion buscarv, para traer el dato de Latitud 
  • LONGITUD= idem que longitud
  • FECHA= se extrae del nombre del archivo de la colunma A
  • HORA= tambien se extrae del nombre del archivo de la colunma A
  • ESPECIE= lo mismo que sitio, solo que se usa el caso "C"
  • REGISTRO INDEPENDIENTE= se carga manual
  • TIPO DE REGISTRO=  se carga manual
  • OBSERVACIONES=   lo mismo que sitio, solo que se usa el caso "D"
  • flanco= lo mismo que sitio, solo que se usa el caso "E"
  • sexo= lo mismo que sitio, solo que se usa el caso "F"
  • edad= lo mismo que sitio, solo que se usa el caso "G"
  • individuo =  lo mismo que sitio, solo que se usa el caso "H"
  • IDENTIFICADOR DEL REGISTRO = SE CARGA MANUAL
  • USUARIO QUE CREO EL REGISTRO EN SISTEMA= SE CARGA MANUAL
  • Responsable del registro (Propiedad Dato)= SE CARGA MANUAL
  • institución = SE CARGA MANUAL
  • Uso libre o reservado= SE CARGA MANUAL
  • Uso de la imagen (I)= lo mismo que sitio, solo que se usa el caso "I"
  • Observación (K) = lo mismo que sitio, solo que se usa el caso "K"
  • Muerto o vivo (J) = lo mismo que sitio, solo que se usa el caso "J"
  • Animal problema, capturado o muerto= SE CARGA MANUAL
  • Link a la foto= Se usa la formula hipervinculo y se pone el path completo del archivo, para que al hacer click me lo habra directamente.
  • EXIFDatos- Keywords /ACA VAN LOS TAGS O ETIQUETAS ANTES DEL SPLIT SEAN DE VIDEOS O FOTOS = debo extraerlos en el caso de las fotos con el getdetails y con los videos con el exiftool en su valor HierarchicalSubject.
  • Todos los datos a continuacion si se obtienen directamente del .getdetails.
  • EXIFDatos- Folder
  • EXIFDatos- FechaImportancion
  • EXIFDatos- Size
  • EXIFDatos- Extension
  • EXIFDatos- DateCaptura
  • EXIFDatos- ModeloCamara
  • EXIFDatos- FabricanteCamara
Hace 27 minutos , Héctor Miguel dijo:

(probablemente) convendría procesar en dos hojas, una para las fotos y otra para los videos
(o procesar en dos partes, primero fotos y luego videos ?)

Estaba pensando similar a lo que dices... o hacemos dos hojas, una para fotos o videos, pero considerando que tienen los mismos datos , es decir las mismas colunmas no se si conviene o no, ademas mayormente van a ser fotos, y en menor medidas videos

Pero si quizas ahora era muy lento porque al momento de cargar esos datos en la hoja, tambien aplicaba las formulas, quizas haya que cargar primero en la hoja todos los datos asi como vienen y luego procesarlos uno por uno...

Link to comment
Share on other sites

Perdon tienes razon que vi hoy que el csv que te habia adjuntado anoche no era el que yo habia extraido para mostrarte los datos de los videos sino que eran jpg, por eso volvi a hacer ahora varias veces para chequear  esto que me preguntas, y si , siempre me los exporta con el mismo formato como te lo subi en el archivo hoy.

Usa siempre la coma como delimitador, quizas me confundi entre tanto y tantos archivos de prueba... perdon fue sin querer...

asi de alborotada anda mi cabeza con este dilema tambien 🤔

Link to comment
Share on other sites

Hace 3 horas, roa30 dijo:

asi de alborotada anda mi cabeza con este dilema tambien

con la herramienta, según el tipo de video, los datos que necesitas:
- "A.Sitio|San jorge, B.Estacion|Alcostado, C.Especie|Cerdocyon thous, D.Observaciones|2 ind."

se localizan en el encabezado:
- para *.avi en "HierarchicalSubject" (columna "90")
- para *.mp4" en "Subject" (columna "38")
- tendrás otro tipo de videos (*.mp3", *.mov, *.wmf, *.flv, *.mkv, etc.) ?

el resto de 105 encabezados, un tipo los muestra y otros no (la mayoría en diferente columna/encabezado)

y (efectivamente) para videos, un "getDetailsOf" no muestra algunos de los datos que requieres

como veras, "sigo haciendo mi chamba" (pero faltan aun ciertos "detalles finos" ?)

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

Privacy Policy