디렉토리(폴더)내의 파일 목록을 구하는 함수입니다.
다중선택은 안되고, 서브폴더까지 검색합니다.
ToDo: Target root 폴더에 파일이 없으면 종료되는 문제(서브디렉토리 파일 count까지 합하도록 변경 필요) -> 이부분 해결 방법 아시는 분은 댓글 남겨주시면 감사하겠습니다.
내용은 다음과 같습니다.
'Force the explicit declaration of variables
Option Explicit' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2017-Oct-28 Initial Release
' 2 2017-Oct-28 Enter the folder name
' 3 2017-Oct-29 Use File Dialog
' **************************************************************************************
Sub ListFiles()
'Declare the variables
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String
Dim strFile As String
Dim NextRow As Long
'Added Codes Begin
Dim Msg As String
Call clearContents
'Open the file dialog
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
'MsgBox (.SelectedItems(1))
strPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Msg = "Write down the folder name, please: " & vbCr
'Msg = Msg & "e.g. C:\Users\Steve\Documents\Vids\"
'strPath = Trim(InputBox(Msg, "Input"))
If right(strPath, 1) <> "\" Then strPath = strPath & "\"
'Added Codes End
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder
Set objFolder = objFSO.GetFolder(strPath)
'If the folder does not contain files, exit the sub
If objFolder.Files.Count = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Turn off screen updating
Application.ScreenUpdating = False
'Insert the headers for Columns A, B, and C
Cells(1, "A").Value = "FileName"
Cells(1, "B").Value = "Path"
Cells(1, "C").Value = "Size"
'Find the next available row
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
'Loop through each file in the folder
For Each objFile In objFolder.Files
'List the name, size, and date/time of the current file
Cells(NextRow, 1).Value = objFile.Name
Cells(NextRow, 2).Value = objFile.Path
Cells(NextRow, 3).Value = objFile.Size
'Determine the next row
NextRow = NextRow + 1
Next objFile
'Change the width of the columns to achieve the best fit
'Columns.AutoFit
'Turn screen updating back on
Application.ScreenUpdating = True
End SubSub clearContents()
Worksheets("List").Range("A1").EntireColumn.EntireRow.clearContents
End Sub
'SI개발 > VBA' 카테고리의 다른 글
[VBA] Format Yahoo Fantasy Players List (0) | 2023.02.03 |
---|---|
[VBA]디렉토리 안의 파일 목록 구하기2 (0) | 2022.12.11 |
[VBA] 차트 범례 추가, 삭제 (0) | 2021.03.27 |
[VBA] 엑셀 디아블로2 my log(엑셀), jimmy's log(본문) (0) | 2016.03.27 |
[VBA]Excel. DB칼럼명을 Camel, pascal로 변환 (0) | 2016.03.26 |