나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 dew (dewdrop)

추천:  2
파일:     조회:  1777
제목:   [RE]PC 드라이브 내의 폴더와 파일의 리스트화
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):

* 아래줄에 질문을 작성하세요 >>

현재 아래와 같은 매크로를 사용해서,
PC(USB) 내의 폴더 및 파일의 리스트를 뽑아내고 있는데,
폴더 내에 파일이 없는 경우(공폴더)에는 파일리스트가 나오지 않더라구요. 공폴더의 경우에도 리스트화 될 수 있도록 하려면 여기서 뭘 더 추가해야할까요? ㅠㅠ

Sub GetFileListFromFolder()
     Dim wstX As Worksheet
     Dim msoFD As FileDialog
     Dim das
     Dim strFolder As String, strFn As String, strPs As String
     Dim colResult As Collection
     Dim lngCnt As Long, lngX As Long
     Dim vRow() As Variant
     Dim intSub As Integer
     
     Dim intArrayMax As Integer      '배열 최대값
    
     Dim sFld As String
     Dim rX As Range

     strPs = Application.PathSeparator
     Set msoFD = Application.FileDialog(msoFileDialogFolderPicker)
     With msoFD
         .Show
         .InitialView = msoFileDialogViewList
         .Title = "검색할 폴더를 선택하세요"
         .AllowMultiSelect = False

         If .SelectedItems.Count = 0 Then Exit Sub
         strFolder = .SelectedItems(1)
     End With
             
     Set wstX = ActiveSheet
     wstX.UsedRange.EntireColumn.Delete

     intSub = MsgBox("하위폴더도 검색하시겠습니까?", vbYesNo, "하위폴더 선택")
     
     Set colResult = SearchFolder(strFolder, intSub)
     lngCnt = colResult.Count
     intArrayMax = UBound(colResult(1))

     ReDim vRow(1 To lngCnt, 1 To intArrayMax)
     For lngX = 1 To lngCnt
         strFn = colResult(lngX)(2)
         vRow(lngX, 1) = Left(colResult(lngX)(1), Len(colResult(lngX)(1)) - Len(strFn))
         If Left(strFn, 1) = "=" Or Left(strFn, 1) = "-" Or Left(strFn, 1) = "+" Then strFn = "'" & strFn
         vRow(lngX, 2) = strFn
         vRow(lngX, 3) = colResult(lngX)(3)
         vRow(lngX, 4) = colResult(lngX)(4)
     Next

     sFld = "경로/파일명/크기/타입"
     
         With wstX
         .Columns(3).NumberFormat = "#,##0"" Byte"";@"

         With .Cells(3, 1).Resize(, intArrayMax)  ' 필드위치
            .Value = Split(sFld, "/")
             .HorizontalAlignment = xlCenter
             .Interior.ColorIndex = 24
             .Font.Bold = True
         End With
         
         .Cells(4, 1).Resize(lngCnt, intArrayMax) = vRow  ' 데이터 위치
        .Cells(4, 1).Select

         With ActiveWindow
             .FreezePanes = True
             .DisplayGridlines = False
         End With
         With .UsedRange
             .Borders.LineStyle = xlContinuous
             .Borders.ColorIndex = 37
             .Columns.AutoFit
         End With
     End With
 End Sub

 Function SearchFolder(strRoot As String, intSub As Integer)
     Dim FSO As Object, fsoFD As Object, fsoFl As Object
     
     Dim colFile As Collection
     Dim strPs As String

     On Error Resume Next
     strPs = Application.PathSeparator
     If Right(strRoot, 1) <> strPs Then strRoot = strRoot & strPs

     Set FSO = CreateObject("Scripting.FileSystemObject") '후기 바운딩의 경우
    Set fsoFD = FSO.Getfolder(strRoot)
     
     Set colFile = New Collection
     For Each fsoFl In fsoFD.Files
         colFile.Add GetInformation(fsoFl)
     Next

     If intSub = vbYes Then    '하위 폴더검색 여부 확인
        SearchSubfolder colFile, fsoFD
     End If

     Set SearchFolder = colFile
     Set fsoFD = Nothing
     Set FSO = Nothing
     Set colFile = Nothing
 End Function

 Sub SearchSubfolder(colFile As Collection, objFolder As Object)
     Dim sbFolder As Object
     Dim fsoFl As Object

     For Each sbFolder In objFolder.subfolders
         SearchSubfolder colFile, sbFolder
         For Each fsoFl In sbFolder.Files
             colFile.Add GetInformation(fsoFl)
         Next
     Next sbFolder
 End Sub

 Function GetInformation(ByVal OBJ As Object)
     Dim strS(1 To 4)

     strS(1) = OBJ.Path
     strS(2) = OBJ.Name
     strS(3) = OBJ.Size
     strS(4) = OBJ.Type
    
     GetInformation = strS
 End Function



==============[스트링치즈님 글에 대한 답변입니다]==============

Sub SearchSubfolder(colFile As Collection, objFolder As Object)
    Dim sbFolder As Object
    Dim fsoFl As Object

    For Each sbFolder In objFolder.SubFolders
        SearchSubfolder colFile, sbFolder
'''''''''''아래부분 추가'''''''''''''''''
        If sbFolder.Files.Count < 1 Then colFile.Add Array("", sbFolder.Path, "", "", "")
''''''''''''''''''''''''''''''''''''''''''
        For Each fsoFl In sbFolder.Files
            colFile.Add GetInformation(fsoFl)
        Next
    Next sbFolder
End Sub
 
[불량 게시물 신고]  
스트링치즈헉 감사합니다 ! 들숨에 건강을, 날숨에 재력을 얻으시길,,09-10 (12:14)
삭제 ■신고
        
  

작성일 : 2019-09-10(10:45)
최종수정일 : 2019-09-10(10:45)
 


 ◎ 관련글

  제 목   작성자   날짜
PC 드라이브 내의 폴더와 파일의 리스트화 스트링치즈 2019-09-09
[RE]PC 드라이브 내의 폴더와 파일의 리스트화 dew 2019-09-10