如何打开特定文件夹以列出其中的文件

How to open a specific folder to list files within

我是 VBA 的新手,正在努力让 Excel sheet 做我想做的事情,任何帮助将不胜感激。

我正在构建一个 excel sheet,它将导入特定文件夹中文件的文件名和属性。我已经删除了我在网上找到的 VBA 代码的其他几个示例,并对其中的大部分进行了排序(因此为什么不需要大部分代码,但我将其留作参考),文件名与我想要显示的属性。

我遇到的问题是我似乎无法让它在每次代码运行时打开特定文件夹,它只是默认为我的文档文件夹(理想情况下我希望它查看网络共享但我我不确定这是否可能)

当我手动 select 一个文件夹时,它还会列出文件夹结构中的每个文件,我只想要该文件夹的内容,但我可以在第一步(希望很简单)排序后选择它.

感谢任何建议

Sub ListFiles()
' Workbooks.Add
' create a new workbook for the file list

' add headers
'Clear out existing data
    ActiveWindow.Panes(1).Activate
    Range("B9:D50").Select
    Selection.ClearContents

'Set column headers
'With Range("A8")
    '.Font.Bold = True
    '.Font.Size = 10
'End With
'Range("A8").Formula = "File Name:"
'Range("B8").Formula = "Path:"
'Range("C8").Formula = "File Size:"
'Range("D8").Formula = "Date Created:"
'Range("E8").Formula = "Date Last Modified:"
'Range("F8").Formula = "Owner:"
    Range("B9:I9").Font.Bold = False
    Range("B10:I50").Font.Bold = False

'Add comments
    'Range("A1").Select
    'Selection.ClearComments
    'Range("N1").AddComment
    'Range("N1").Comment.Visible = False
    'Range("N1").Comment.Text Text:="ZZZZZZZZZ" & Chr(10) & "ZZZZZZZ"
    'Range("N1").Select

 ' Prompt user for destination file name.
   Application.FileDialog(msoFileDialogFolderPicker).Show
    MyPath = CurDir + "\"
ListFilesInFolder MyPath, True


End Sub


Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
  Dim FSO As Object
  Dim SourceFolder As Object
  Dim SubFolder As Object
  Dim FileItem As Object
  Dim r As Long

     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set SourceFolder = FSO.GetFolder(SourceFolderName)

       r = Range("B65536").End(xlUp).Row + 1
       For Each FileItem In SourceFolder.Files
        'display file properties
         Cells(r, 2).Formula = FileItem.Name
         'Cells(r, 2).Formula = FileItem.Path
         'Cells(r, 3).Formula = FileItem.Size
         Cells(r, 3).Formula = FileItem.DateCreated
         Cells(r, 4).Formula = FileItem.DateLastModified
         'Cells(r, 6).Formula = GetFileOwner(SourceFolder.Path, FileItem.Name)
         r = r + 1 ' next row number
         x = SourceFolder.Path
       Next FileItem

       If IncludeSubfolders Then
         For Each SubFolder In SourceFolder.SubFolders
           ListFilesInFolder SubFolder.Path, False
         Next SubFolder
       End If

    'Columns("A:G").AutoFit
    'Columns("H:I").AutoFit
    'Columns("J:L").AutoFit
    'Columns("M:P").AutoFit

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing

    ActiveWorkbook.Saved = False

End Sub


Function GetFileOwner(ByVal FilePath As String, ByVal FileName As String)

  Dim objFolder As Object
  Dim objFolderItem As Object
  Dim objShell As Object

    FileName = StrConv(FileName, vbUnicode)
    FilePath = StrConv(FilePath, vbUnicode)

     Set objShell = CreateObject("Shell.Application")
     Set objFolder = objShell.Namespace(StrConv(FilePath, vbFromUnicode))

       If Not objFolder Is Nothing Then
         Set objFolderItem = objFolder.ParseName(StrConv(FileName, vbFromUnicode))
       End If

       If Not objFolderItem Is Nothing Then
         GetFileOwner = objFolder.GetDetailsOf(objFolderItem, 8)
       Else
         GetFileOwner = ""
       End If

     Set objShell = Nothing
     Set objFolder = Nothing
     Set objFolderItem = Nothing

End Function

调用Show前必须设置InitialFileName:

Sub ListFiles()
    ' etc
    With Application.FileDialog(msoFileDialogFolderPicker)
        ' Notice the slash at the end
        .InitialFileName = "\server\share\folder\"
        ' Disable multiple selections since it seems you would want that
        .AllowMultiSelect = False
        If .Show = -1 Then
            ' Since user didn't cancel and multiple selections are disabled,
            ' there will be only one selected item
            MyPath = .SelectedItems(1)
            ' Call your code here
            ListFilesInfolder MyPath, True
        End If
End With

结束子

Here是MSDN上相关文档的link。