VBA for Excel - 查找文件列表的路径

Question

我还没有使用VBA编码，所以我需要你的帮助才能加快我的工作速度。基本上这就是我的需要：

A栏（我提供的）：文件清单

B栏（我正在寻找）：文件路径

你可以给我任何建议吗？我认为这应该是一个简单的代码，但我还不知道如何开始。提前谢谢。

此致，Andrea

以下是更多信息......

输入：

1234XX12345_Sheet3_2

输出：

1234XX12345_Sheet1_2

1234XX12345_Sheet2_2

1234XX12345_Sheet3_2

虽然它“扩展”了我想在目录中搜索它并写入路径的工作表数量。我希望它足够清楚^^'

Public Function LastRow(colonna As String) As Long
LastRow = ActiveSheet.Cells(Rows.Count, colonna).End(xlUp).Row
End Function

Public Function LastCol(riga As Integer) As Long
LastCol = ActiveSheet.Cells(riga, Columns.Count).End(xlToLeft).Column
End Function

Public Function Recurse(sPath As String) As String

Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim myFile As File

Set myFolder = FSO.GetFolder(sPath)

For Each mySubFolder In myFolder.SubFolders
    For Each myFile In mySubFolder.Files
        If myFile.Name = Range(Foglio1.Cells(ultimax, 2)).Value Then
            Foglio1.Cells(ultimax, 3) = myFile.Path
            Exit For
        End If
    Next
    Recurse = Recurse(mySubFolder.Path)
Next

End Function

并命令Box：

Private Sub CommandButton1_Click()
Dim ultimax As Long
Dim n_sheet As Integer
Dim iso As String

Foglio1.Range("B2:B1000000").Clear

ultimax = 2
For i = 2 To LastRow("A")
    a = Split(Foglio1.Cells(i, 1), "_")
    n_sheet = Replace(a(1), "Sheet", "") * 1
    For j = 1 To n_sheet 
        Foglio1.Cells(ultimax, 2) = a(0) & "_" & Left(a(1), 5) & j & "_" & a(2) & ".pdf"
        Call Recurse("C:\Users\VVVVV\Desktop\TEST_VB")
        ultimax = ultimax + 1
    Next j
Next i
MsgBox "FINISH!!"
End Sub

Answer 1

好的我已经找到了一个解决方案，它现在可以正常工作但是有很多文件夹和文件需要太长时间来结束这个过程，我怎么能加快它？这是代码：

Public Function LastRow(colonna As String) As Long
LastRow = ActiveSheet.Cells(Rows.Count, colonna).End(xlUp).Row
End Function

Public Function LastCol(riga As Integer) As Long
LastCol = ActiveSheet.Cells(riga, Columns.Count).End(xlToLeft).Column
End Function

Public Function Recurse(sPath As String, PP As Long) As String

Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim myFile As File

Set myFolder = FSO.GetFolder(sPath)

For Each mySubFolder In myFolder.SubFolders
    For Each myFile In mySubFolder.Files
        If myFile.Name = Foglio1.Cells(PP, 2) Then
            Foglio1.Cells(PP, 3) = myFile.Path
            Exit For
        End If
    Next
    Recurse = Recurse(mySubFolder.Path, PP)
Next

End Function


Private Sub CommandButton1_Click()
Dim ultimax As Long
Dim n_sheet As Integer
Dim iso As String
Dim PP As String


Foglio1.Range("B2:B1000000").Clear
Foglio1.Range("C2:B1000000").Clear

ultimax = 2
For i = 2 To LastRow("A")
    a = Split(Foglio1.Cells(i, 1), "_")
    n_sheet = Replace(a(1), "Sheet", "") * 1
    For j = 1 To n_sheet
        Foglio1.Cells(ultimax, 2) = a(0) & "_" & Left(a(1), 5) & j & "_" & a(2) & ".pdf"
        Call Recurse("C:\Users\DDDDD\Desktop\folder\", ultimax)
        ultimax = ultimax + 1
    Next j
Next i
MsgBox "FINISH!!"
End Sub