从图片中获取 TAG 元数据 - 文件夹和子文件夹 - Vbscript答案

【问题标题】：Getting TAG metadata from pictures - Folder and Subfolder - Vbscript从图片中获取 TAG 元数据 - 文件夹和子文件夹 - Vbscript
【发布时间】：2019-07-20 22:27:31
【问题描述】：

我正在整理我的照片，所以我想要一个可以将我照片中的所有标签写入 Txt 文件的 VBscript。该脚本将从保存在不同子文件夹中的照片中读取标签并写入所有标签而不重复，因此我可以在此文件上拥有唯一标签的列表。

txtFile 将保存在 Vbs 文件的同一目录中。我的文件夹有子文件夹。

【问题讨论】：

标签： vbscript metadata photo directory-structure

【解决方案1】：

以下代码是为在 Excel (VBA) 上使用而开发的。我试图将其翻译成 VBS 但没有成功。归功于 MVP Rick Rothstein。如果我们可以将代码修改为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

【讨论】：

【解决方案2】：

在这个论坛中搜索，我发现了下面用于从数组中获取唯一值的惊人代码。

Getting Unique Values from Arrays

现在我需要知道如何解决循环内的行代码问题：

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

【讨论】：