2008. 6. 11. 10:10

지정한 폴더들의 이름 목록을 표시하는 엑셀 함수

지정한 드라이브의 하위포함 폴더 이름을 표시해 주는 엑셀 함수
폴더가 한단계씩 내려갈 수록 컬럼도 한칸씩 들어가도록 되어 있음
인터넷에서 찾은 VB소스를 엑셀에 맞게 조금 수정해서 사용하였음
엑셀 모듈에서 아래의 코드를 복사한 이후 직접 실행에서

FindFiles "C:\","A",1

같은 방법으로 실행하면 됨

'start_dir : 찾기 시작할 경로
' strStartCal : 기록을 시작할 컬럼명
' iStartRow : 기록을 시작할 ROW 번호
Function FindFiles(ByVal start_dir As String, ByVal strStartCal As String, ByVal iStartRow As Integer) As Integer
 Dim dirs() As String
 Dim dir_names() As String
 Dim num_dirs As Long
 Dim sub_dir As String
 Dim sub_name As String
 Dim file_name As String
 Dim i As Integer

 DoEvents
  
 sub_dir = Dir$(start_dir & "*", vbDirectory)
 Do While Len(sub_dir) > 0
     If UCase$(sub_dir) <> "PAGEFILE.SYS" And sub_dir <> "." And sub_dir <> ".." Then
  sub_name = sub_dir
  sub_dir = start_dir & sub_dir
  If GetAttr(sub_dir) And vbDirectory Then
      num_dirs = num_dirs + 1
      ReDim Preserve dirs(1 To num_dirs)
      ReDim Preserve dir_names(1 To num_dirs)
      dirs(num_dirs) = sub_dir & "\"
      dir_names(num_dirs) = sub_name
  End If
     End If

     sub_dir = Dir$(, vbDirectory)
 Loop

        '각각의 폴더에 대해 파일 찾기/재귀 호출
        For i = 1 To num_dirs
            Range(strStartCal + CStr(iStartRow)).FormulaR1C1 = dir_names(i)
            iStartRow = iStartRow + 1
            iStartRow = FindFiles(dirs(i), Chr(Asc(strStartCal) + 1), iStartRow)
            DoEvents
        Next i
 '결과 반환
 FindFiles = iStartRow
End Function