Photographers here -- apart from Photoshop want app to extract EXIF info from photos

'MNG 18/10/25  List EXIF data in jpg files
'source: https://superuser.com/questions/1408564/vbscript-to-extract-date-taken-from-a-photo
'most returned values confirmed by IrfanView

Option Explicit
Const   ForWriting          = 2
Const   FileCreate          = True
Const   TristateTrue        = 0     'We are OK with just ASCII data (I think), need -1 for unicode
Dim WshShell, sCurrentFolderName, sOutputFileName
Dim oFS, oImg, oTS, iPos, sExt, sprop, oCF, ofi, oShell, oBFF, sfn, spath

Set WshShell        = WScript.CreateObject("WScript.Shell")
sCurrentFolderName    = WshShell.CurrentDirectory
sOutputFileName        = sCurrentFolderName & "\EXIF data.txt"

Set oFS                = WScript.CreateObject("Scripting.FileSystemObject")
Set oTS                = oFS.OpenTextFile(sOutputFileName, ForWriting, FileCreate, TristateTrue)
Set oImg            = WScript.CreateObject("WIA.ImageFile")
Set oShell = CreateObject("Shell.Application")
Set oCF = oShell.Namespace(sCurrentFolderName)
'Browse for a folder - can't go above start point - room for improvement!
Set oBFF = oShell.BrowseForFolder( 0, "Select Folder", 0, oCF)

For Each ofi in oBFF.Items                    'for each file in folder (does not search sub-folders)
    sfn = ofi.name                            'get file name
    spath = oBFF.self.path                    'and path to it
    sfn = spath&"\"&sfn                        'combine to create fully-defined file path
                                            '(there may be a better way to do this)
'    WScript.Echo sfn                        'comfort the user when it all fails
    iPos    = InStrRev(sfn, ".")            'find first 'dot'
    if iPos > 0 then                        'folders have no . ! (I don't know if they will be found)
        sExt = Mid(sfn, iPos)                'extract file extension
        If (LCase(sExt) = ".jpg") Then        'for jpg only (this could also be improved)
            sprop = props(sfn)                'get all available properties
            oTS.WriteLine sprop                'write to file
            WScript.Echo sprop                'and screen until we are sure it works
        End If
    end if
Next
oTS.Close                                    'should probably delete objects also

Function props(sFileName)                    'read properties (mostly EXIF data)
    Dim s, prp

    oImg.LoadFile sFileName                    'Needs complete path
    s = "File: " & sFileName & vbcrlf & "prop count: " & oImg.Properties.Count & vbcrlf
    For Each prp In oImg.Properties            'seems to find 2 less than count?
        If prp.IsVector = False Then        'not sure what this excludes
            s = s & prp.propertyID & ": " & prp.name & " == " & prp.Value & vbcrlf
        end if
    next
    props = s
End Function