|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(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
|
|