2013. 1. 21. 09:05

EXCEL MACRO-엑셀에서 파일리스트 보기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

엑셀 시트에서 파일폴더를 열고 해당 파일 폴더와 하위 폴더의 파일들을 읽어오는 매크로입니다. 

업무 중에 필요한 부분이라 만들었습니다. 


엑셀 매크로 작성 방법은 엑셀에서 보기->매크로기록 기능을 사용해서 기본적인 기능을 확인한 후 필요한 부분을 개선하는 방식으로 했습니다. 

또 추가적으로 필요한 부분은 인터넷에서 검색하여 추가했습니다. 


필요하신 분은 참조해서 사용하세요. 


참고로 시트의 D4열에 필터 값을 입력해야 합니다. 


*.xls* 등의 형식으로 입력하면됩니다. 



Sub getFolder()


    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    

    ' 현재 있는 데이터를 모두 삭제해야 함.

    ' 첫번째 시트에서 작업을 합니다.

    Sheets(1).Activate

    ActiveSheet.Range("d3").Value = ""

    ActiveSheet.Range("b9:f10000").Value = ""

    ActiveSheet.Cells(8, 6).Value = 9

    

    '서브폴더의 내용을 가져옴

    ' folderspec에는 폴더 주소가 기재됩니다.


    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            Range("d3") = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장

            folderspec = Range("d3").Value

            getSubFolder (folderspec)

        End If

    End With

    

End Sub


'하위폴더를 조회하는 기능입니다. 

Sub getSubFolder(folderspec)

    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    

    strDir = Range("d3").Value

    If strDir = "" Then

        MsgBox (" 선택된 폴더가 없습니다. 폴더를 선택하세요.")

        Exit Sub

    End If

        

    r = 8

    

    Sheets(1).Cells(r, 2) = "폴더명"

    Sheets(1).Cells(r, 3) = "파일명"

    

    Sheets(2).Range("a1:d1").Font.Name = "Arial"

    

     '이 소스는 인터넷에서 가져온것입니다. 

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    

    strFilter = Range("d4").Value

    

    result = sRetrieve(strDir, strFilter, r)

    '여기까지.

     

End Sub


     '이 소스는 인터넷에서 가져온것입니다. 

Private Function sRetrieve(sPath As String, strFilter As String, r As Long) As String

    

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    

    For Each dDir In dDirs.SubFolders

        sRetrieve = sRetrieve(dDir.Path, strFilter, r)

    Next

    

    For Each fFile In dDirs.Files

        If fFile.Name Like strFilter Then

            Sheets(1).Cells(r, 2) = fFile.parentfolder.Path

            Sheets(1).Cells(r, 3) = fFile.Name

            r = r + 1

        End If

    Next

    

    Set fs = Nothing

    

End Function