如何打开特定文件夹以列出其中的文件
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。
我是 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。