从excel中的文件夹和子文件夹中列出完整的详细信息

我正在尝试创build一个文件寄存器，它将在最后列出所选文件夹和所有子文件夹中的某些文件，目前我的代码下面列出了文件及其path。 虽然我不能想到我需要添加到这个代码，以获得Excel表创build一个列，列出文件types“PDF”，“TXT”，DWG“等列。然后，另一列使用预定义列表显示这些文件的types（即pdf =文档，DWG = CAD文件等）。

接下来我要添加的是从path列中生成的超链接。

最后是有一种方法，我可以使excel忽略之前收集的数据，因为数据将从中收集的文件夹定期更新，我希望能够运行VBA，因此它将忽略子文件夹已经从中拉出数据。

非常感激任何的帮助。

Option Explicit 'the first row with data Const ROW_FIRST As Integer = 5 'This is an event handler. It exectues when the user 'presses the run button Private Sub btnGet_Click() 'determines if the user selects a directory 'from the folder dialog Dim intResult As Integer 'the path selected by the user from the 'folder dialog Dim strPath As String 'Filesystem object Dim objFSO As Object 'the current number of rows Dim intCountRows As Integer Application.FileDialog(msoFileDialogFolderPicker).Title = _ "Select a Path" 'the dialog is displayed to the user intResult = Application.FileDialog( _ msoFileDialogFolderPicker).Show 'checks if user has cancled the dialog If intResult <> 0 Then strPath = Application.FileDialog(msoFileDialogFolderPicker _ ).SelectedItems(1) 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'loops through each file in the directory and prints their 'names and path intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO) 'loops through all the files and folder in the input path Call GetAllFolders(strPath, objFSO, intCountRows) End If End Sub ''' 'This function prints the name and path of all the files 'in the directory strPath 'strPath: The path to get the list of files from 'intRow: The current row to start printing the file names 'in 'objFSO: A Scripting.FileSystem object. Private Function GetAllFiles(ByVal strPath As String, _ ByVal intRow As Integer, ByRef objFSO As Object) As Integer Dim objFolder As Object Dim objFile As Object Dim i As Integer i = intRow - ROW_FIRST + 1 Set objFolder = objFSO.GetFolder(strPath) For Each objFile In objFolder.Files 'print file name Cells(i + ROW_FIRST - 1, 1) = objFile.Name 'print file path Cells(i + ROW_FIRST - 1, 2) = objFile.Path i = i + 1 Next objFile GetAllFiles = i + ROW_FIRST - 1 End Function ''' 'This function loops through all the folders in the 'input path. It makes a call to the GetAllFiles 'function. It also makes a recursive call to itself 'strFolder: The folder to loop through 'objFSO: A Scripting.FileSystem object 'intRow: The current row to print the file data on Private Sub GetAllFolders(ByVal strFolder As String, _ ByRef objFSO As Object, ByRef intRow As Integer) Dim objFolder As Object Dim objSubFolder As Object 'Get the folder object Set objFolder = objFSO.GetFolder(strFolder) 'loops through each file in the directory and 'prints their names and path For Each objSubFolder In objFolder.subfolders intRow = GetAllFiles(objSubFolder.Path, _ intRow, objFSO) 'recursive call to to itsself Call GetAllFolders(objSubFolder.Path, _ objFSO, intRow) Next objSubFolder End Sub 

Answer 1

解决scheme：在Function GetAllFiles进行以下更改 – 适用于我：

Dim i As Integer ，添加：

 Dim Extension As String 

Cells(i + ROW_FIRST - 1, 2) = objFile.Path ，添加：

 Extension = Right(objFile.Path, Len(objFile.Path) - InStrRev(objFile.Path, ".")) Cells(i + ROW_FIRST - 1, 3) = Extension Cells(i + ROW_FIRST - 1, 4) = objFile.Type Cells(i + ROW_FIRST - 1, 5).Formula = "=HYPERLINK(""" & objFile.Path & """,""Link"")" 

说明：通过查找点来填充Extensionvariables. 在文件名和只使用什么是正确的点。 然后将其添加到下一列。 该扩展的描述取自文件对象的Type属性。 最后，最右边的列填充=HYPERLINK函数指向文件及其path。

---

编辑：编辑提示@TimWilliams（谢谢！），我简化了上面的代码。 如果您需要自定义的文件types说明 ，请使用下面的方法，然后replace

 Cells(i + ROW_FIRST - 1, 4) = objFile.Type 

同

 On Error Resume Next Cells(i + ROW_FIRST - 1, 4) = Application.WorksheetFunction.VLookup(Extension, _ ActiveWorkbook.Sheets("filetypes").Range("A:B"), 2, False) 

在运行之前，需要添加一个名为filetypes的工作表，并将A列中最常见的扩展名及其长文本/解释放到B列中：

为了得到一个没有太多工作的列表，你可以复制你在这个网站上find的东西，并删除点. 使用search和replacefunction。