VBA for Excel - finding path of a list of file

Question

I'm not yet on VBA coding so I need your help for speeding up my work. Basically this is what I need:

Column A (what I provide): list of file

Column B (what I'm looking for): Path of file

Can you give me any advice? I think that should be a simple code but I don't know yet how to start. Thank you in advance.

Regards, Andrea

Here's more information...

Input:

1234XX12345_Sheet3_2

Output:

1234XX12345_Sheet1_2

1234XX12345_Sheet2_2

1234XX12345_Sheet3_2

While it "expand" the number of sheet i'd like to search for it in a directory and write the path. I hope it's clear enough ^^'

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

And command 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

This might help: https://stackoverflow.com/questions/20687810/vba-macro-that-search-for-file-in-multiple-subfolders — Olly, Aug 21 '17 at 08:08
This is not a free coding service. People are here to help you with specific issues in your code, so you can solve the issues yourself, people are not here to do all the work for you, especially not to speed up your work. The guy who has to do the work is you not us. Without showing what you already have tried, what is already working and where you got stuck or where you got any errors we cannot provide any help. — Pᴇʜ, Aug 21 '17 at 09:40
Thx for the reference Olly. Peh, i know that is not a free coding service, sorry to bother you — tariland, Aug 21 '17 at 12:06

score 0 · Answer 1 · answered Aug 22 '17 at 05:18

Ok i've found a solution, it does work now but with many folder and files it takes way too long to end the process, how could i speed up it? Here's the code:

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

VBA for Excel - finding path of a list of file

1 Answers1