Excel用VBA - ファイル一覧のパスを見つける

Question

私はまだVBAコーディングしていないので、私の仕事をスピードアップするためにあなたの助けが必要です。基本的にこれは私が必要なものである：

は列A（私が提供するもの）：ファイルのリスト

（私が探しているものを）カラムB：ファイルのパス

缶あなたは私に助言を与える？私はそれが単純なコードでなければならないと思うが、私はまだ始める方法を知らない。前もって感謝します。

よろしく、アンドレア

ここではより多くの情報があります...

入力：

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 

とコマンドボックス：

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

[OK]を、私はそれが今の仕事をして、解決策を見つけたが、多くのフォルダやファイルを、それはへの道に時間がかかりすぎますどのように私はそれをスピードアップできますか？

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