Question

我正在尝试根据文件的“标题”或“标签”元数据将文件从一个位置复制到另一个位置，但是我似乎无法做到这一点，而且我不确定为什么。

这是我的代码：

Path = "C:\Users\blahblah"
destination = "C:\Users\blahblah\blibbityblah"
Set FSO = CreateObject("Scripting.filesystemobject")
Set obj_folder = FSO.GetFolder(Path)

For Each obj_subfolder In obj_folder.SubFolders
    For Each file In obj_subfolder.FILES
        If InStr(1, file.BuiltInDocumentProperties("title"), "Blah") Then
            Debug.Print file.BuiltInDocumentProperties("title")
            Call FSO.CopyFile(file.Path, FSO.BuildPath(destination, file.Name))
        End If
    Next file
Next obj_subfolder

这在这里中断，并且我收到一条错误消息，指出该对象不支持该属性或方法：

If InStr(1, file.BuiltInDocumentProperties("title"), "Blah") Then

此外，我还尝试使用shell对象按如下方式标识工作簿的标签：

Path = "C:\Users\blahblah"
destination = "C:\Users\blahblah\blibbityblah"
Set FSO = CreateObject("Scripting.filesystemobject")
Set obj_folder = FSO.GetFolder(Path)
Set shell_object = CreateObject("shell.application")
Set dir_object = shell_object.Namespace(CVar(Path))

For Each obj_subfolder In obj_folder.SubFolders
    For Each file In obj_subfolder.FILES
        If InStr(1, file.Name, ".xlsx") Then
            Debug.Print dir_object.getdetailsof(file, 18)
            'Call FSO.CopyFile(file.Path, FSO.BuildPath(destination, file.Name))
        End If
    Next file
Next obj_subfolder

当我手动查看时，文件中的标签数据显示为“ Blah”，但是当我进行debug.print时，其标签数据仅为“ Tags”。有人可以在这里指引我正确的方向吗？谢谢。

编辑

我还尝试过将.Value附加到.BuiltInDocumentsProperties的末尾，结果相同。
我还下载并安装了Dsofile.dll文件，并添加了具有相同结果的引用。

Answer 1

下面是显示如何使用Shell.Application检索文件详细信息的示例：

Option Explicit

Sub Test()

    Dim oDetails, sName

    Set oDetails = GetDetails("C:\Users\blahblah\blibbityblah\test.xlsx")
    If oDetails.Exists("Tags") Then Debug.Print oDetails("Tags")
    If oDetails.Exists("Title") Then Debug.Print oDetails("Title")
    Debug.Print String(40, "-")
    For Each sName In oDetails
        Debug.Print sName & " = " & oDetails(sName)
    Next

End Sub

Function GetDetails(sPath)

    Dim sFolderName, sFileName, oShell, oFolder, oFile, oDetails, i, sName, sValue

    SplitFullPath sPath, sFolderName, sFileName
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace(sFolderName)
    Set oFile = oFolder.ParseName(sFileName)
    Set oDetails = CreateObject("Scripting.Dictionary")
    For i = 0 To 511
        sName = oFolder.GetDetailsOf(oFolder.Items, i)
        sValue = oFolder.GetDetailsOf(oFile, i)
        If sName <> "" And sValue <> "" Then oDetails(sName) = sValue
    Next
    Set GetDetails = oDetails

End Function

Sub SplitFullPath(sPath, sFolderName, sFileName)

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(sPath) Then Exit Sub
        sFolderName = .GetParentFoldername(sPath)
        sFileName = .GetFileName(sPath)
    End With

End Sub

如何使用Excel VBA从封闭的工作簿中读取元数据信息？

1 个答案: