简体   繁体   English

下面的VBA代码填充同一工作表中的文件名列表,但是我希望将结果数据集生成到另一个工作表中吗?

[英]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.

相关问题 相同的Worksheet_Activate代码,但工作表2上的范围不同 - Same Worksheet_Activate Code But With Different Ranges Not Working on Sheet 2 Excel 2007 VBA - 使用VLOOKUP在不同工作表中查找值并将结果存储在活动工作表中 - Excel 2007 VBA - Use VLOOKUP to find value in different worksheet and store result in active sheet VBA代码可在一张纸上工作,但不能在第二张纸上工作 - vba code works on one sheet but not the second worksheet VBA代码可使用文件名将一个工作表中的多个单元格粘贴到另一个工作表中 - VBA Code to paste multiple cells from one worksheet into another with the filenames 如何在同一个工作表上运行多个 VBA 代码 - How can I run multiple VBA code on the same worksheet VBA / Excel宏-尝试使用从一个工作表绘制并跨多个工作表填充的数组简化代码 - VBA/Excel macro - trying to simplify code using an array that draws from one worksheet and populates across multiple worksheets VBA代码将具有颜色的单元格复制到同一工作表中的不同单元格 - VBA Code to Copy Cells with Color to different cells in same sheet VBA代码可使用VBA工作表名称和可见来打印多张工作表 - VBA Code to Print Multiple Sheet using the VBA Worksheet name and Visible Excel VBA:在另一个工作表上创建图表之前,如何在一个工作表上对数据进行排序? - Excel VBA: How do I sort data on one worksheet before creating a chart on a different sheet? 相同的 VBA 代码在同一个工作表中用于 2 组不同的表格第一个有效,第二个无效 - Same VBA code in the same worksheet for 2 different sets of table the first works, the second doesnt
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM