[VBA] 현재 폴더의 모든 파일 가져오기

현재 폴더 또는 지정한 폴더의 모든 파일을 엑셀에다가 뿌려주는 VBA 코드이다.

Option Explicit
Sub CurrentPath_FindFiles()
    Dim FSO As New FileSystemObject
    Dim objFSO, objFolder, objFile As Object
    Dim r%
    Dim fPath, openMsg As String
   
    Application.ScreenUpdating = False
    Set FSO = CreateObject("Scripting.FileSystemObject")     '// Create an instance of the FileSystemObject
    openMsg = "파일을 가져올 경로를 직접 지정하려면 Yes를 눌러주세요 " & vbCr & vbCr
    openMsg = openMsg & "현재 경로를 선택하려면 No를 눌러주세요" & vbCr
    openMsg = openMsg & "현재 Path : " & ThisWorkbook.Path + "\"
    If MsgBox(openMsg, vbYesNo) = vbYes Then
        '// [도구] - [참조] 에서 Microsoft Scripting Runtime 라이브러리 체크해야 함
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            fPath = .SelectedItems(1)   '// 선택될 폴더를 경로 변수에 저장
        End With
    Else
        fPath = ThisWorkbook.Path + "\"     '// 엑셀 VBA 파일이 위치한 현재경로
    End If
    If Err.Number <> 0 Or fPath = False Then Exit Sub
    On Error GoTo 0
   
    Set objFolder = FSO.GetFolder(fPath)     '// Get the folder object
    Range([A1], Cells(Rows.Count, "A").End(3)).Offset(1).Resize(, 2).ClearContents  '// 결과영역 초기화
    r = 2
    For Each objFile In objFolder.Files
        Cells(r, 1) = Left(objFile.Path, InStrRev(objFile.Path, "\"))
        Cells(r, 2) = objFile.Name
        r = r + 1
    Next objFile
End Sub

이번에는 다른 방식으로 현재 폴더의 파일을 가져오는 VBA 코드이다.

Option Explicit
Sub CurrentPath_FindFiles()
    Dim FSO As New FileSystemObject
    Dim objFSO, objFolder, objFile As Object
    Dim r%, T As Single
    Dim fPath, fName, openMsg, getExt As String
    Dim SaveDir As Range
    Dim sDir As Folder      '// 찾을 폴더 변수 선언
   
    Application.ScreenUpdating = False
    T = Timer()
    Set FSO = CreateObject("Scripting.FileSystemObject")     '// Create an instance of the FileSystemObject
    openMsg = "파일을 가져올 경로를 직접 지정하려면 Yes를 눌러주세요 " & vbCr & vbCr
    openMsg = openMsg & "현재 경로를 선택하려면 No를 눌러주세요" & vbCr
    openMsg = openMsg & "현재 Path : " & ThisWorkbook.Path + "\"
    If MsgBox(openMsg, vbYesNo) = vbYes Then
        '// [도구] - [참조] 에서 Microsoft Scripting Runtime 라이브러리 체크해야 함
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            fPath = .SelectedItems(1)   '// 선택될 폴더를 경로 변수에 저장
        End With
    Else
        fPath = ThisWorkbook.Path + "\"     '// 엑셀 VBA 파일이 위치한 현재경로
    End If
    If Err.Number <> 0 Or fPath = False Then Exit Sub
    On Error GoTo 0
   
    Range([A1], Cells(Rows.Count, "A").End(3)).Offset(1).Resize(, 2).ClearContents  '// 결과영역 초기화
    fPath = IIf(Right(fPath, 1) = "\", fPath, fPath & "\")
    getExt = "*.mp3"
    fName = Dir(fPath & getExt)     '// 파일의 존재 여부를 판단하기 위해 Dir 함수를 사용
    If fName <> "" Then
        Do
            Set SaveDir = Cells(Rows.Count, "A").End(3)(2)
            SaveDir.Value = fPath
            SaveDir.Offset(0, 1).Value = fName
            fName = Dir()       '// 검색된 새로운 파일 정보를 fName 변수에 저장
        Loop While fName <> ""
    End If
    MsgBox "완료!! " & vbLf & vbLf & Format(Timer() - T, "0.00초 걸림"), 64, Now()
End Sub

현재폴더파일가져오기.xlsm