Getting TAG metadata from pictures - Folder and Subfolder - Vbscript

Question

I'm organizing my photos so I would like a VBscript that can Write all TAGs from my photos in a Txt file. The Script Will read the Tags from the photos that are saved on different subfolders and Write all the Tags without repetions, so I can have a list of unique Tags on this file.

The txtFile will be saved on same directory of the Vbs file. My folder has subfolders.

score 0 · Answer 1 · answered Jul 21 '19 at 22:35

The following code was developed to be used on Excel (VBA). I tried to translate it to VBS but without success. Credits to MVP Rick Rothstein. I guess it is a start if we can modify the code to VBS.

Sub UniqueTextFileItems()
  Dim R As Long, FileNum As Long, TotalFile As String, Data As Variant
  FileNum = FreeFile
  Open "c:\temp\test.txt" For Binary As #FileNum 
    TotalFile = Space(LOF(FileNum))
    Get #FileNum , , TotalFile
  Close #FileNum 
  Data = Split(Join(Split(TotalFile, vbCrLf), ","), ",")
  With CreateObject("Scripting.Dictionary")
    For R = 0 To UBound(Data)
      If Len(Data(R)) Then .Item(Data(R)) = 1
    Next
    Data = .Keys
  End With
  With CreateObject("System.Collections.ArrayList")
    For R = 0 To UBound(Data)
      .Add Data(R)
    Next
   .Sort
    Range("A1").Resize(.Count) = Application.Transpose(.ToArray)
  End With
End Sub

score 0 · Answer 2 · answered Jul 28 '19 at 10:31

Searching in this forum I found the amazing code below for getting the unique values from arrays.

Getting Unique Values from Arrays

Now I need to know how to solve the problem on line code inside the loop:

Set objDirectory = objShell.Namespace(vFile)

Dim myArr As Variant

Sub TestFunction()
Dim colFiles As New Collection
Dim MyPath As String

MyPath = "C:\Photos"
ReDim Preserve myArr(0)

RecursiveDir colFiles, MyPath, "*.jpg", True

Dim objShell: Set objShell = CreateObject("Shell.Application")
Dim objDirectory
Dim vFile As Variant

For Each vFile In colFiles
'I'm getting Error here - I cannot dynamically refer the namespace
    Set objDirectory = objShell.Namespace(vFile)
    ReDim Preserve myArr(UBound(myArr) + 1)
    If Len(Trim(objDirectory.GetDetailsOf(vrFile, 18))) > 0 Then
        myArr(UBound(myArr)) = objDirectory.GetDetailsOf(vrFile, 18)
    Else
    End If
Next vFile
End Sub  

Public Function RecursiveDir(colFiles As Collection, _
                         strFolder As String, _
                         strFileSpec As String, _
                         bIncludeSubfolders As Boolean)

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    strTemp = Dir
Loop

If bIncludeSubfolders Then
    'Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                colFolders.Add strTemp
            End If
        End If
        strTemp = Dir
    Loop

    'Call RecursiveDir for each subfolder in colFolders
    For Each vFolderName In colFolders
        Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
    Next vFolderName
End If

End Function

Public Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
    If Right(strFolder, 1) = "\" Then
        TrailingSlash = strFolder
    Else
        TrailingSlash = strFolder & "\"
    End If
 End If
End Function

Getting TAG metadata from pictures - Folder and Subfolder - Vbscript

2 Answers2