VBA Excel：フォルダとサブフォルダの特定の拡張子を検索し、タイトルを入力してください。

Question

サブフォルダのファイル拡張子（ '.csv'）をフォルダ内で検索し、ファイルタイトルをExcelワークブックに書き込むためにVBAコードを作成する必要があります。

Answer 1

私は似たような状況があったと私は、この作業だ：

Sub foo() 
Dim iFilesNum As Integer 
Dim iCount As Integer 
Dim recMyFiles() As FoundFileInfo 
Dim blFilesFound As Boolean 


Dim LastRow As Long 
With ActiveSheet 
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
End With 

For xy = 2 To LastRow 

blFilesFound = FindFiles(Sheet1.Cells(xy, 1).Value, recMyFiles, iFilesNum, "*.csv", True) 'where column 1 on Sheet1 contains the Paths to be searched, include more rows with more paths to search through them too 
If blFilesFound Then 
    For iCount = 1 To iFilesNum 
     With recMyFiles(iCount) 
      Sheet2.Cells(iCount, 1).Value = .sPath & .sName 'place the results in Sheet2 
     End With 
    Next 
Else 
    MsgBox "No file(s) found matching the specified file spec.", vbInformation, "File(s) not Found" 
End If 

Next xy 
MsgBox iFilesNum 
End Sub 

をそして、モジュールに次の行を追加します。

Type FoundFileInfo 
    sPath As String 
    sName As String 
End Type 

Function FindFiles(ByVal sPath As String, _ 
    ByRef recFoundFiles() As FoundFileInfo, _ 
    ByRef iFilesFound As Integer, _ 
    Optional ByVal sFileSpec As String, _ 
    Optional ByVal blIncludeSubFolders As Boolean = True) As Boolean 

    Dim iCount As Integer   '* Multipurpose counter 
    Dim sFileName As String   '* Found file name 
    '* 
    '* FileSystem objects 
    Dim oFileSystem As Object, _ 
     oParentFolder As Object, _ 
     oFolder As Object, _ 
     oFile As Object 

    Set oFileSystem = CreateObject("Scripting.FileSystemObject") 
    On Error Resume Next 
    Set oParentFolder = oFileSystem.GetFolder(sPath) 
    If oParentFolder Is Nothing Then 
     FindFiles = False 
     On Error GoTo 0 
     Set oParentFolder = Nothing 
     Set oFileSystem = Nothing 
     Exit Function 
    End If 
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\") 
    '* 
    '* Find files 
    sFileName = Dir(sPath & sFileSpec, vbNormal) 
    If sFileName <> "" Then 
     For Each oFile In oParentFolder.Files 
      If LCase(oFile.Name) Like LCase(sFileSpec) Then 
       iCount = UBound(recFoundFiles) 
       iCount = iCount + 1 
       ReDim Preserve recFoundFiles(1 To iCount) 
       With recFoundFiles(iCount) 
        .sPath = sPath 
        .sName = oFile.Name 
       End With 
      End If 
     Next oFile 
     Set oFile = Nothing   '* Although it is nothing 
    End If 
    If blIncludeSubFolders Then 
     '* 
     '* Select next sub-forbers 
     For Each oFolder In oParentFolder.SubFolders 
      FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders 
     Next 
    End If 
    FindFiles = UBound(recFoundFiles) > 0 
    iFilesFound = UBound(recFoundFiles) 
    On Error GoTo 0 
    '* 
    '* Clean-up 
    Set oFolder = Nothing   '* Although it is nothing 
    Set oParentFolder = Nothing 
    Set oFileSystem = Nothing 

End Function