'2017/10'에 해당되는 글 1건

  1. 2017.10.28 [VBA]디렉토리 안의 파일 목록 구하기

디렉토리(폴더)내의 파일 목록을 구하는 함수입니다.

다중선택은 안되고, 서브폴더까지 검색합니다.

ToDo: Target root 폴더에 파일이 없으면 종료되는 문제(서브디렉토리 파일 count까지 합하도록 변경 필요) -> 이부분 해결 방법 아시는 분은 댓글 남겨주시면 감사하겠습니다.

 

listFiles_v3.xls

 

내용은 다음과 같습니다.

'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 Sub

Sub clearContents()
    Worksheets("List").Range("A1").EntireColumn.EntireRow.clearContents
End Sub

 

1 

글 보관함

카운터

Total : / Today : / Yesterday :
get rsstistory!