| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007) : 엑셀 2013
* 아래줄에 질문을 작성하세요 >>
PC 드라이브의 폴더 및 파일의 이름을 엑셀로 리스트화 하고 싶습니다.
오피스튜터 예전 자료중에 매크로를 이용해서 한 자료가 있는데,
폴더는 리스트화가 되지않고, 폴더 안의 파일만 리스트화가 되더라구요.
폴더의 이름까지 엑셀로 리스트화 할수 있는 방법 알려주시면 너무 감사하겠습니다 !
==============[스트링치즈님 글에 대한 답변입니다]==============
Sub GetFileListFromFolder()
Dim wstX As Worksheet
Dim msoFD As FileDialog
dim d as
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(1).Resize(, intArrayMax)
.Value = Split(sFld, "/")
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 24
.Font.Bold = True
End With
.Cells(2, 1).Resize(lngCnt, intArrayMax) = vRow
.Cells(2, 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
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
