Excel VBA,文件夹子文件夹搜索excel文件并显示信息

我试图使用下面在其他地方找到的代码,我已经对其进行了调整,并且可以正常工作。我遇到的问题是我正在请求信息的单元格没有显示.....

任何想法?

另外,为了方便起见,我希望objfile.path是一个超链接,而不是整个路径。

代码:

'Force the explicit delcaration of variables
Option Explicit

Sub ListFiles()

'Set a reference to microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String

'Insert the headers for Columns A through N
Range("B1").Value = "Customer P.O:"
Range("C1").Value = "Sales Order Number:"
Range("D1").Value = "Works Order Number:"
Range("E1").Value = "Purchase Order:"
Range("F1").Value = "Date Dispatched Est'd:"
Range("G1").Value = "Date Est'd Return:"
Range("H1").Value = "Sub-Contractor:"
Range("I1").Value = "Sub-Contractor Ref No:"
Range("J1").Value = "Sub-Con Report Received:"
Range("K1").Value = "Reports Verified By:"
Range("L1").Value = "Date Booked Back In:"
Range("M1").Value = "Date Last Modified:"
Range("N1").Value = "File Name:"
Range("O1").Value = "Link To File:"

'Assign the top folder to a variable
strTopFolderName = "Desktop/Board"

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the top folder
Set objTopFolder = objFSO.GetFolder(strTopFolderName)

'Call the RecursiveFolder routine
Call RecursiveFolder(objTopFolder,True)

'Change the width of the columns to achieve the best fit
Columns.AutoFit

End Sub



Sub RecursiveFolder(objFolder As Scripting.Folder,_
IncludeSubFolders As Boolean)

'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long

'Find the next available row
NextRow = Cells(Rows.Count,"A").End(xlUp).Row + 1

'Loop through each file in the folder
For Each objFile In objFolder.Files
    Cells(NextRow,"B").Value = Range("AD1").Value
    Cells(NextRow,"C").Value = Range("AD2").Value
    Cells(NextRow,"D").Value = Range("AD3").Value
    Cells(NextRow,"E").Value = Range("AD4").Value
    Cells(NextRow,"F").Value = Range("AD5").Value
    Cells(NextRow,"G").Value = Range("AD6").Value
    Cells(NextRow,"H").Value = Range("AD7").Value
    Cells(NextRow,"I").Value = Range("AD8").Value
    Cells(NextRow,"J").Value = Range("AD9").Value
    Cells(NextRow,"K").Value = Range("AD10").Value
    Cells(NextRow,"L").Value = Range("AD11").Value
    Cells(NextRow,"M").Value = objFile.DateLastModified
    Cells(NextRow,"N").Value = objFile.Name
    Cells(NextRow,"O").Value = objFile.Path
    NextRow = NextRow + 1
Next objFile

'Loop through files in the subfolders
If IncludeSubFolders Then
    For Each objSubFolder In objFolder.SubFolders
        Call RecursiveFolder(objSubFolder,True)
    Next objSubFolder
End If

End Sub

感谢您的帮助!!!!!!!!!!!

qmm1030798770 回答:Excel VBA,文件夹子文件夹搜索excel文件并显示信息

暂时没有好的解决方案,如果你有好的解决方案,请发邮件至:iooj@foxmail.com
本文链接:https://www.f2er.com/3081691.html

大家都在问