从excel中读取文件夹和任何文档属性？

Question

我想尝试一些东西，我很确定这是可能的，但不是真的确定！

在 MS Excel (2003) 中，我可以编写一个 VBA 脚本来打开一个位置（例如：s://public/marketing/documents/）并列出其中的所有文档（文件名）吗？

最终目标是按名称获取文档名称、上次修改日期、创建和修改日期。

这可能吗？我想在工作表的行中返回任何找到的值。 eg: type: FOLDER, type: Word Doc等

感谢您提供任何信息！

Answer 1

最近做了。使用 DSOFile 对象。在 Excel-VBA 中，您首先需要创建对 Dsofile.dll 的引用（“DSO OLE Document Properties Reader 2.1”或类似版本）。还要检查您是否参考了 Office 库

首先您可能要选择要检查的文件路径

Sub MainGetProps()
Dim MyPath As String

    MyPath = GetDirectoryDialog()
    If MyPath = "" Then Exit Sub

    GetFileProps MyPath, "*.*"
End Sub

让我们有一个漂亮的路径选择窗口

Function GetDirectoryDialog() As String
Dim MyFD As FileDialog

    Set MyFD = Application.FileDialog(msoFileDialogFolderPicker)
    With MyFD
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count <> 0 Then
            GetDirectoryDialog = .SelectedItems(1)
        End If
    End With

End Function

现在让我们使用 DSO 对象来读取信息...我将代码简化为必要的代码

Private Sub GetFileProps(MyPath As String, Arg As String)
Dim Idx As Integer, Jdx As Integer, MyFSO As FileSearch, MyRange As Range, MyRow As Integer
Dim DSOProp As DSOFile.OleDocumentProperties

    Set DSOProp = New DSOFile.OleDocumentProperties
    Set MyRange = ActiveSheet.[A2]  ' your output is nailed here and overwrites anything

    Set MyFSO = Application.FileSearch

    With MyFSO
        .NewSearch
        .LookIn = MyPath
        .SearchSubFolders = True ' or false as you like
        .Filename = Arg
        .FileType = msoFileTypeAllFiles
        If .Execute() > 0 Then
            MsgBox .FoundFiles.Count & " file(s) found."  ' to see what you will get
            For Idx = 1 To .FoundFiles.Count

                DSOProp.Open .FoundFiles(Idx) ' examine the DSOProp element in debugger to find all summary property names; not all may be filled though
                Debug.Print .FoundFiles(Idx)
                Debug.Print "Title: "; DSOProp.SummaryProperties.Title
                Debug.Print "Subject: "; DSOProp.SummaryProperties.Subject
                ' etc. etc. write it into MyRange(Idx,...) whatever

                ' now hunt down the custom properties
                For Jdx = 0 To DSOProp.CustomProperties.Count - 1
                    Debug.Print "Custom #"; Jdx; " ";
                    Debug.Print " Name="; DSOProp.CustomProperties(Jdx).Name;
                    If DSOProp.CustomProperties(Jdx).Type <> dsoPropertyTypeUnknown Then
                        Debug.Print " Value="; DSOProp.CustomProperties(Jdx).Value
                    Else
                        Debug.Print " Type=unknowwn; don't know how to print";
                    End If
                    MyRow = MyRow + 1
                Next Jdx
                DSOProp.Close
            Next Idx
        Else
            MsgBox "There were no files found."
        End If
    End With
End Sub

应该就是这样

祝你好运迈克D