하위폴더의 자료들을 가져오는 코드
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 |
'VB(A)' 카테고리의 다른 글
셀값이 같은 행으로 정렬 (0) | 2015.08.09 |
---|---|
누적되지 않는 실시간 그래프 (0) | 2015.08.09 |
배열의 합, 최대치 구하기 (0) | 2015.07.28 |
A시트와 B시트의 필터링 값을 각각의 파일로 저장 (0) | 2015.07.27 |
대량의 데이터 변환 (0) | 2015.07.27 |