Uso de ExifTool en VBA para trabajar con metainformación de archivos Exif

Hace un tiempo publiqué varios artículos sobre cómo trabajar con imágenes y otros archivos para leer/escribir metadatos Exif:

• Eliminación de propiedades Exif de imagen usando WIA en VBA
• Configuración de una propiedad Exif de imagen usando WIA en VBA
• Obtener propiedades de imagen (metadatos Exif) usando WIA en VBA
• Obtener propiedades de imagen (metadatos Exif) usando FreeImage
• Obtenga propiedades de imagen Exif usando VBA y PowerShell
• Crear/configurar una propiedad de imagen usando la API GDI+
• Cómo recuperar las propiedades de un archivo con VBA
• etc.

Bueno, mientras desarrollaba todas esas técnicas, seguí viendo menciones de ‘exiftool’, que es un programa independiente diseñado por Phil Harvey para trabajar específicamente con información de archivos Exif. Así que hoy pensé en mostrarles a todos cómo podemos aprovechar esta herramienta a través de VBA.

ExifHerramienta

Pues bien, lo primero que tenemos que hacer para poder trabajar con la herramienta es descargar una copia gratuita. ¿Mencioné que es GRATIS?

Vaya a la página web oficial de ExifTool:

y descargue la copia adecuada para su configuración.

A continuación, simplemente extraiga su contenido a una carpeta de su elección. Elegí instalarlo en un subdirectorio ‘\exiftool\’.

Ahora, si lee las instrucciones en el archivo sitio/léame, a continuación debe cambiar el nombre del archivo ‘exiftool(-k).exe’ a ‘exiftool.exe’.

¡Ahora estamos listos para usarlo! Sí, lo bueno de esta herramienta es que en realidad no es necesario instalarla para trabajar con ella. Sólo necesita llamarlo y proporcionar los modificadores de línea de comando que le interesen. Por lo tanto, es 100% portátil.

Usando ExifTool con VBA (Access, Excel, Word, Outlook,…)

Algunas funciones auxiliares

Bueno, como es habitual, para simplificar la codificación real de ExifTool, utilicé un par de funciones auxiliares. Así que aquí están.

Utilicé mi función Clipboard_GetText() de VBA: guardar cadena en el portapapeles, obtener cadena del portapapeles, pero a continuación se muestra la función en sí para evitar que tengas que estar dando vueltas:

'---------------------------------------------------------------------------------------
' Procedure : Clipboard_GetText
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Retrieve the clipboard value
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: Late Binding  -> none required
' 
'
' Usage:
' ~~~~~~
' Debug.Print Clipboard_GetText
' sClipboardValue = Clipboard_GetText
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2020-11-25              Initial Public Release
'---------------------------------------------------------------------------------------
Public Function Clipboard_GetText() As String
    On Error GoTo Error_Handler

    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        Clipboard_GetText = .GetText
    End With

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Clipboard_GetText" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Esto se utilizará para recuperar los resultados de la ejecución de exiftool en algunos casos.

A continuación, necesitamos poder ejecutar el comando y para ello usamos WScript.Shell. Ahora, en lugar de incorporar eso en cada procedimiento, tiene más sentido tener una función reutilizable que podamos ejecutar. Entonces usé:

Function oWshShell_RunCommand(sCmd As String, _
                              Optional bDebugMode As Boolean = False) As String
    If bDebugMode Then
        ' Development => Display window to user / Do not close cmd prompt
        Debug.Print sCmd
        CreateObject("Wscript.Shell").Run "cmd /k " & sCmd, 1, True
    Else
        ' Production  => Hide window from user / Close cmd prompt once operation completed
        CreateObject("Wscript.Shell").Run "cmd /c " & sCmd, 0, True
    End If
End Function

pero si desea una versión más sólida, le recomiendo que siga el procedimiento de mi artículo Ejecutar comandos Cmd y devolver los resultados.

Entonces, ahora estamos realmente listos para utilizar la utilidad ExifTool para jugar con los metadatos Exif.

Procedimientos Exif VBA

Obtener la ruta/nombre de archivo de ExifTool

Para facilitar la actualización del código en caso de que fuera necesario, hice que la ubicación del exiftool.exe se recuperara mediante una función. De esta manera, solo se podrá realizar una actualización en caso de que se mueva.

Public Function ET_GetExe() As String
    Static sAppPath As String
    
    If sAppPath = "" Then
        'sAppPath = """" & "C:\...\...\exiftool.exe" & """"
        sAppPath = """" & Application.CurrentProject.Path & "\exiftool\exiftool.exe" & """"
    End If
    
    ET_GetExe = sAppPath
End Function

Así que ahora, sólo necesita cambiar la línea sAppPath =… para actualizar la ubicación de exiftool.exe y el resto del código permanece sin cambios.

Obtener todos los metadatos

'? ET_GetAllMetaInformation("C:\Temp\IMG01.jpg")
Function ET_GetAllMetaInformation(sFile As String, _
                                  Optional bShowDuplicateTags As Boolean = False, _
                                  Optional bDisplayOriginalTagNames As Boolean = False) As String
    Dim sCmd                  As String

    sCmd = ET_GetExe()
    If bShowDuplicateTags Then sCmd = sCmd & " -a"
    If bDisplayOriginalTagNames Then sCmd = sCmd & " -S"
    sCmd = sCmd & " -fast"
    sCmd = sCmd & " -sort"
    sCmd = sCmd & " """ & sFile & """ | clip"
    sCmd = """" & sCmd & """"
    Call oWshShell_RunCommand(sCmd)

    DoEvents
    ET_GetAllMetaInformation = Clipboard_GetText
End Function

Obtener un valor de metaetiqueta específico

'? ET_GetSpecificMetaTag("C:\Temp\IMG01.jpg", "ShutterSpeed")
'? ET_GetSpecificMetaTag("C:\Temp\IMG01.jpg", "Software")
'? ET_GetSpecificMetaTag("C:\Temp\IMG01.jpg", "MIMEType")
Function ET_GetSpecificMetaTag(sFile As String, _
                               sTagName As String) As String
    Dim sCmd                  As String
    Dim sValue                As String

    sCmd = ET_GetExe()
    sCmd = sCmd & " -fast"
    sCmd = sCmd & " -s -s -s" 'Only return value
    sCmd = sCmd & " -" & sTagName
    sCmd = sCmd & " """ & sFile & """ | clip"
    sCmd = """" & sCmd & """"
    Call oWshShell_RunCommand(sCmd)

    DoEvents
    ET_GetSpecificMetaTag = Clipboard_GetText
    
    ' Approach without -s -s -s
    '    sValue = Clipboard_GetText
    '    ET_GetSpecificMetaTag = Mid(sValue, InStr(sValue, ": ") + 2)
End Function

Obtener metadatos mediante una búsqueda con comodines

'? ET_GetWildcardMetaTag("C:\Temp\IMG01.jpg", "File")
'? ET_GetWildcardMetaTag("C:\Temp\IMG01.jpg", "File", , True)
Function ET_GetWildcardMetaTag(sFile As String, _
                               sTagName As String, _
                               Optional bShowDuplicateTags As Boolean = False, _
                               Optional bDisplayOriginalTagNames As Boolean = False) As String
    Dim sCmd                  As String
    Dim sValue                As String

    sCmd = ET_GetExe()
    If bShowDuplicateTags Then sCmd = sCmd & " -a"
    If bDisplayOriginalTagNames Then sCmd = sCmd & " -S"
    sCmd = sCmd & " -fast"
    sCmd = sCmd & " -sort"
    sCmd = sCmd & " -*" & sTagName & "*"
    sCmd = sCmd & " """ & sFile & """ | clip"
    sCmd = """" & sCmd & """"
    Call oWshShell_RunCommand(sCmd)

    DoEvents
    ET_GetWildcardMetaTag = Clipboard_GetText
End Function

Eliminar todos los metadatos de un archivo

'ET_RemoveAllMetaTags "C:\Temp\IMG01a.jpg"
Function ET_RemoveAllMetaTags(sFile As String)
    Dim sCmd                  As String
    Dim sValue                As String

    sCmd = ET_GetExe()
    sCmd = sCmd & " -All="
    sCmd = sCmd & " -overwrite_original"
    sCmd = sCmd & " """ & sFile & """"
    sCmd = """" & sCmd & """"
    Call oWshShell_RunCommand(sCmd)
End Function

Eliminar un valor de metaetiqueta específico de un archivo

'ET_RemoveSpecificMetaTag "C:\Temp\IMG01a.jpg", "ImageDescription"
'ET_RemoveSpecificMetaTag "C:\Temp\IMG01a.jpg", "Make"
Function ET_RemoveSpecificMetaTag(sFile As String, _
                                  sTagName As String)
    Dim sCmd                  As String
    Dim sValue                As String

    sTagName = Replace(sTagName, " ", "") 'Cheap fix

    sCmd = ET_GetExe()
    sCmd = sCmd & " -" & sTagName & "="
    sCmd = sCmd & " -overwrite_original"
    sCmd = sCmd & " """ & sFile & """"
    sCmd = """" & sCmd & """"
    Call oWshShell_RunCommand(sCmd)
End Function

Actualizar un valor de metaetiqueta específico

Lo siguiente se puede utilizar para crear y/o actualizar una entrada de metaetiqueta existente.

' ET_UpdateSpecificMetaTag "C:\Temp\IMG01a.jpg", "Make", "IMakeCamerasNow"
Function ET_UpdateSpecificMetaTag(sFile As String, _
                                  sTagName As String, _
                                  sTagValue As String)
    Dim sCmd                  As String
    Dim sValue                As String

    sTagName = Replace(sTagName, " ", "") 'Cheap fix

    sCmd = ET_GetExe()
    sCmd = sCmd & " -" & sTagName & "=""" & sTagValue & """"
    sCmd = sCmd & " -overwrite_original"
    sCmd = sCmd & " """ & sFile & """"
    sCmd = """" & sCmd & """"
    Call oWshShell_RunCommand(sCmd)
End Function

Obtener el recuento de páginas de un archivo Tif/Tiff

'? ET_GetTifPageCount("C:\Temp\MultiPageTif_Test.tif")
Function ET_GetTifPageCount(sFile As String) As Long
    'PageCount doesn't return a value for tifs with 1 page
    Dim vPageCount As Variant
    
    vPageCount = ET_GetSpecificMetaTag(sFile, "PageCount")
    If vPageCount = "" Then vPageCount = 1
    
    ET_GetTifPageCount = vPageCount
End Function

Ejemplos de uso

En la mayoría de los casos, he incluido un ejemplo comentado del uso de cada procedimiento. Sin embargo, ET_GetAllMetaInformation() podría ser un poco complicado de descomponer para los nuevos desarrolladores, así que pensé en proporcionar un posible ejemplo de cómo podría usarse más allá de simplemente llamarlo.

Sub ET_GetAllMetaInformation_Test()
    Dim oTagDic               As Object
    Dim sTagsData             As String
    Dim aTags()               As String
    Dim sTag                  As String
    Dim sTagName              As String
    Dim sTagValue             As String
    Dim iCounter              As Long

    On Error Resume Next

    sTagsData = ET_GetAllMetaInformation("C:\Temp\IMG01.jpg", , True)
    aTags = Split(sTagsData, vbCrLf)

    Set oTagDic = CreateObject("Scripting.Dictionary")
    For iCounter = 0 To UBound(aTags()) - 1
        sTag = aTags(iCounter)
        sTagName = Mid(sTag, 1, InStr(sTag, ":") - 1)
        sTagValue = Mid(sTag, InStr(sTag, ": ") + 2)
        oTagDic.Add sTagName, sTagValue
    Next iCounter

    'Now that we have a collection we can pull the data as we please...
    Debug.Print "File Name", oTagDic("FileName")
    Debug.Print "Image Size", oTagDic("ImageSize")
    Debug.Print "File Type", oTagDic("FileType")
    Debug.Print "Color Space", oTagDic("ColorSpace")

    Set oTagDic = Nothing
End Sub

lo que da como resultado 4 líneas de información que se envían a la ventana inmediata.

Este ejemplo demuestra cómo puede dividir de manera efectiva todos los datos devueltos por ET_GetAllMetaInformation() en líneas individuales y luego dividirlos en Nombre de etiqueta y Valores y pasarlos a un objeto de diccionario con el que luego puede trabajar como desee. Sólo uno de los muchos usos posibles.

Otra posibilidad sería enviar la información recuperada a un cuadro de lista, podríamos hacerlo con algo como un sub auxiliar como:

Private Sub PushMetaDatToListBox(sFile As String, _
                                 lst As Access.ListBox)
    Dim sTagsData             As String
    Dim aTags()               As String
    Dim sTag                  As String
    Dim sTagName              As String
    Dim sTagValue             As String
    Dim iCounter              As Long

    On Error Resume Next

    lst.RowSource = ""

    sTagsData = ET_GetAllMetaInformation(sFile, , True)
    aTags = Split(sTagsData, vbCrLf)

    For iCounter = 0 To UBound(aTags()) - 1
        sTag = aTags(iCounter)
        sTagName = Mid(sTag, 1, InStr(sTag, ":") - 1)
        sTagValue = Mid(sTag, InStr(sTag, ": ") + 2)
        lst.AddItem sTagName & ";" & sTagValue
    Next iCounter
End Sub

y luego podríamos implementarlo haciendo:

Call PushMetaDatToListBox("C:\Temp\IMG01.jpg", Me.YourListboxName)

Base de datos de demostración

No dude en descargar una copia 100 % desbloqueada de una base de datos de muestra que he creado para ilustrar algo de lo que se analiza anteriormente mediante el enlace que se proporciona a continuación:

Descargue “Uso de ExifTool en VBA para trabajar con metainformación de archivos Exif” ExifTool.zip – Descargado 82 veces – 53,59 KB

Esta descarga es solo de mi base de datos de demostración, también debe descargar de forma independiente una copia de ExifTool desde el enlace proporcionado anteriormente y luego editar la función ET_GetExe() dentro del módulo VBA mod_ExifTool de la base de datos de demostración para reflejar su ruta de instalación de exiftool.exe. Entonces todo debería funcionar.

Aviso sobre contenido/descargas/demos

Descargo de responsabilidad/Notas:

Si no tiene Microsoft Access, simplemente descargue e instale la versión en tiempo de ejecución disponible gratuitamente (esto permite ejecutar bases de datos de MS Access, pero no modificar su diseño):

Tiempo de ejecución de Microsoft Access 2010
Tiempo de ejecución de Microsoft Access 2013
Tiempo de ejecución de Microsoft Access 2016
Tiempo de ejecución de Microsoft 365 Access

Algunas palabras finales

ExifTool funciona muy bien en mis pruebas y, como puede ver, es relativamente fácil de implementar. Es otra buena herramienta que debemos conocer y agregar a nuestra caja de herramientas de VBA.

Lo anterior es solo una muestra de lo que ExifTool puede hacer con los metadatos, por lo que si esta es un área de interés para usted, revise el sitio web fuente, ya que contiene mucha más información que la que proporciono aquí. Mi objetivo era simplemente demostrar su facilidad de implementación dentro del entorno VBA para realizar las tareas de metadatos más comunes.

Además, sé que la mayoría de la gente piensa en imágenes cada vez que mencionan la palabra Exif o Metadatos, pero casi todos los archivos tienen Metainformación y esta herramienta puede acceder a todos ellos. Imágenes (jpg, png, tiff, bmp, ico,… e incluso formatos más nuevos como webp), txt, zip, xlsx, docx, pdf,… Realmente es interesante probarlo en otros archivos para ver qué adjunta a un archivo. , pero normalmente está oculto para el usuario.

Si está buscando una lista de opciones disponibles (modificadores de línea de comandos), consulte: Descripción general de opciones.

Si está buscando nombres de etiquetas de metadatos disponibles, consulte: Nombres de etiquetas de ExifTool

Historial de la página