Question

我是VBA的新手，我正在努力获得Excel表格来做我想做的事情，我们将非常感谢任何帮助。

我正在构建一个excel表，它将导入特定文件夹中文件的文件名和属性。我已经在网上找到了几个其他的VBA代码示例，并且大部分代码已经排序（因此为什么大部分代码都不需要，但我已将其留作参考），文件名与属性i一起导入想要显示。

我遇到的问题是，每次代码运行时我似乎无法打开特定文件夹，它只是默认为我的文档文件夹（理想情况下我希望它看看网络共享，但我＆＃39 ;我不确定这是否可行）

当我手动选择文件夹时，它列出了文件夹结构中的每个文件，我只想要该文件夹的内容，但我可以在获得第一个（希望很容易）步骤后选择它。

感谢您的任何建议

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

Answer 1

您必须在致电InitialFileName之前设置Show：

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

End Sub

Here是MSDN上相关文档的链接。

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

1 个答案: