[英]The below VBA code populates list of filenames in the same sheet, but I want the result dataset to be generated into a different worksheet?
Please check the below query and help me in modifying the query, so that the result dataset gets populated into a different worksheet. 请检查以下查询,并帮助我修改查询,以便将结果数据集填充到其他工作表中。
Sub MainList()
'Updateby20150706
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("B65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.Subfolders
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function
Please let me know how to do the modification and let me know if you have any questions or comments. 请让我知道如何进行修改,如果您有任何疑问或意见,请告诉我。 Thanks. 谢谢。
Add an index to Application.Worksheets(sheetIndex): Change 将索引添加到Application.Worksheets(sheetIndex):更改
For Each xFile In xFolder.Files
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
rowIndex = rowIndex + 1
Next xFile
to 至
sheetIndex = 1
For Each xFile In xFolder.Files
Application.Worksheets(sheetIndex).Cells(rowIndex, 2).Formula = xFile.Name
rowIndex = rowIndex + 1
sheetIndex = sheetIndex + 1
Next xFile
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.