我试图使用下面在其他地方找到的代码,我已经对其进行了调整,并且可以正常工作。我遇到的问题是我正在请求信息的单元格没有显示.....
任何想法?
另外,为了方便起见,我希望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
感谢您的帮助!!!!!!!!!!!