OfficeTutor.com
배움터 나눔터 교육센터 오튜장터
 통합검색  
  Home > 나눔터 > 엑셀 > 묻고답하기
엑셀
워드
액세스
파워포인트
아웃룩
프런트페이지
인포패스
원노트
비지오
쉐어포인트
포토드로우
퍼블리셔
오피스공통
MVP 안내
MVP 명예의 전당
MVP 카페

 

 

 

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

 dew (dewdrop)

추천:  0
파일:     조회:  113
제목:   [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

 
 
회사소개 | 이용약관 | 개인정보 처리방침 | 회원정보수정 | 교육신청 및 문의 | 이메일무단수집거부 위로

오피스튜터 블로그 오피스튜터페이스북 오피스튜터유투브
110-722 서울 종로구 세종대로23길 47, 601-74 ㈜오피스튜터 ☎1544-4102 대표이사 : 전경수
개인정보관리책임자 : 이희진(privacy@officetutor.com) 사업자등록번호 120-86-14501
통신판매업신고 2013-서울종로-0547
norton
Copyright ⓒ OfficeTutor.com 이 페이지의 저작권은 ㈜오피스튜터와 콘텐츠 제공자에게 있습니다. 무단 복제를 금합니다.
Microsoft 및 Office 로고는 미국, 대한민국 및/또는 기타 국가에서의 Microsoft Corporation 등록 상표 또는 상표입니다.