VB(A)

하위 폴더의 파일명, 수정날짜, 경로 가져오기

당근쨈 2015. 7. 31. 16:20
하위폴더의 자료들을 가져오는 코드
FSO라는 것을 사용해서 하위폴더를 불러오게 되어있다.

Option Explicit
 
 
'매크로 시작 전 도구 - 참조 - Microsoft Scripting Runtime 에 체크할 것
Sub Macro()
 
    Dim strFolderPath As String
    Dim objFSO As New Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
 
    Application.ScreenUpdating = False
 
    '현재경로 선언
    strFolderPath = ThisWorkbook.Path
    Set objFolder = objFSO.GetFolder(strFolderPath)
 
    '기존자료 삭제
    Range("A1").CurrentRegion.Offset(2).ClearContents
 
    '하위폴더의 자료 가져오기
    Call RecursiveFolder(objFolder, True)
 
    '열너비 자동맞춤
    Columns.AutoFit
 
    Application.ScreenUpdating = True
 
End Sub
 
Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
 
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim rngTitle As Range
    Dim strFileName As String
 
    '붙여넣기 위치 선언
    Set rngTitle = Cells(Rows.Count, "A").End(3)(2)
 
    '특정 문자열 선언(구파일과 새로운 파일 구분)
    strFileName = "[DOC]"
 
    '하위폴더 순환하며 파일명 등 가져오기
    For Each objFile In objFolder.Files
 
        '특정문자열이 있을 때 자료 가져옴
        If InStr(objFile.Name, strFileName) Then
            With rngTitle
                .Value = objFile.Name   '파일명
                .Offset(, 1= objFile.DateLastModified '마지막 수정 날짜
                .Offset(, 2= objFolder.Path   '해당 파일의 경로
                Set rngTitle = .Offset(1)   '붙여넣기 위치 재선언
            End With
        End If
    Next objFile
 
    '하위폴더가 존재하면 함수 다시 호출
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
End Sub
cs