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

时间:2010-01-13 16:31:46

标签: excel excel-vba vba

我想尝试一下,我很确定这是可能的,但确实肯定!

在MS Excel(2003)中,我可以编写一个VBA脚本来打开一个位置(例如:s:// public / marketing / documents /)并列出位于那里的所有文件(文件名)?

最终目标是拥有文档名称,上次修改日期,按名称创建和修改日期。

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

感谢您的任何信息!

1 个答案:

答案 0 :(得分:2)

最近完成了。使用DSOFile对象。在Excel-VBA中,首先需要创建对Dsofile.dll(“DSO OLE文档属性读取器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

应该是它

祝你好运MikeD