| |
아래 내용을 참고하세요..
폴더를 검색하여 해당폴더 파일 리스트를 가져오는 예입니다.
Sub GetFileListFromFolder()
Dim wstX As Worksheet
Dim msoFD As FileDialog
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
Const intAMax As Integer = 9 '배열 최대값
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
Else
Set wstX = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
intSub = MsgBox("하위폴더도 검색하시겠습니까?", vbYesNo, "하위폴더 선택")
strFolder = .SelectedItems(1)
Set colResult = SearchFolder(strFolder, intSub)
lngCnt = colResult.Count
ReDim vRow(1 To lngCnt, 1 To intAMax)
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)
vRow(lngX, 5) = colResult(lngX)(5)
vRow(lngX, 6) = colResult(lngX)(6)
vRow(lngX, 7) = colResult(lngX)(7)
vRow(lngX, 8) = colResult(lngX)(8)
vRow(lngX, 9) = colResult(lngX)(1)
Next
sFld = "경로/파일명/크기/타입/만든 날짜/엑세스한 날짜/수정 날짜/속성/FullName"
With wstX
.Columns(5).Resize(, 3).NumberFormat = "yyyy-mm-dd hh:mm:ss;@"
.Columns(3).NumberFormat = "#,##0"" Byte"";@"
With .Cells(1).Resize(, intAMax)
.Value = Split(sFld, "/")
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 24
.Font.Bold = True
End With
.Cells(2, 1).Resize(lngCnt, intAMax) = vRow
.Cells(2, 1).Select
With ActiveWindow
.FreezePanes = True
.DisplayGridlines = False
End With
With .UsedRange
.Borders.LineStyle = xlContinuous
.Borders.ColorIndex = 37
.Columns.AutoFit
For Each rX In .EntireColumn.Columns
If rX.ColumnWidth > 50 Then rX.ColumnWidth = 50
Next
End With
End With
End If
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 8)
strS(1) = ""
strS(1) = OBJ.Path
strS(2) = OBJ.Name
strS(3) = OBJ.Size
'strS(3) = Round(obj.Size / 1024, 0) + IIf(obj.Size Mod 1024 > 0, 1, 0)
strS(4) = OBJ.Type
strS(5) = OBJ.DateCreated
strS(6) = OBJ.DateLastAccessed
strS(7) = OBJ.DateLastModified
strS(8) = OBJ.Attributes & "/" & ShowAttr(OBJ)
GetInformation = strS
End Function
Function ShowAttr(ByVal File As Object) ' File can be a file or folder
Dim strS
Dim Attr
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants returned by File.Attributes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const FileAttrNormal = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32
Const FileAttrAlias = 1024
Const FileAttrCompressed = 2048
Attr = File.Attributes
If Attr = 0 Then ShowAttr = "Normal": Exit Function
If Attr And FileAttrNormal Then strS = strS & "Normal "
If Attr And FileAttrDirectory Then strS = strS & "Directory "
If Attr And FileAttrReadOnly Then strS = strS & "Read-Only "
If Attr And FileAttrHidden Then strS = strS & "Hidden "
If Attr And FileAttrSystem Then strS = strS & "System "
If Attr And FileAttrVolume Then strS = strS & "Volume "
If Attr And FileAttrArchive Then strS = strS & "Archive "
If Attr And FileAttrAlias Then strS = strS & "Alias "
If Attr And FileAttrCompressed Then strS = strS & "Compressed "
ShowAttr = Trim(strS)
End Function
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
