Question

我有一个摘要表，其中包含第1列中的示例名称，另一列包含一个指向网站的超链接，用户可以在其中下载包含数据原始（运行）文件的zip文件夹。我的任务是能够找到与摘要表第1列中相同名称的运行文件，例如如果样本名称为A_02-RD14-0003_23d，则我的代码必须遍历下载的zip文件夹中的所有文件夹和子文件夹，然后找到该样本。使用我当前的代码，只要工作表中的样品名称与下载的zip文件夹中的原始文件匹配，文件路径就会粘贴到第2列中。问题是代码很慢。需要几个小时。另外，我可以使文件路径成为超链接吗？我可以使目标文件夹（objFolder）动态吗？如上所示，而不是让该文件夹路径专用于我的PC；使其动态，以允许用户选择下载的zip文件夹将被保存的任何文件夹路径。这是我的代码...谢谢您。

Option Explicit
'run this macro

    Sub ListAllFiles()

        Dim objFSO As Scripting.FileSystemObject
        Dim objFolder As Scripting.folder

            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objFolder = objFSO.GetFolder("C:\Users\Magwaveni\Desktop\Run Files\")

            Call GetFileDetails(objFolder)

    End Sub

    Function GetFileDetails(objFolder As Scripting.folder)

    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.folder
    Dim i, nextrow, lastrow As Long
    Dim sh As Worksheet
    
    Set sh = ActiveSheet
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    'find last row in col 1
    lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
    'find next blank row in col 2
    nextrow = sh.Cells(Rows.Count, 2).End(xlUp).Row + 1
   
        For Each objFile In objFolder.Files
                For i = 2 To lastrow
                    If Cells(i, 1) = objFile.Name Then
                    Cells(i, 2) = objFile.Path
                    End If
                Next i
            nextrow = nextrow + 1
    
        Next
    
    'Looping throughsubfolders
    For Each objSubFolder In objFolder.subfolders
        Call GetFileDetails(objSubFolder)
    Next
    
    
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
  End Function

循环浏览所有文件夹和子文件夹以获取文件路径

0 个答案: