-
폴더를 순환하며 파일을 루트로 옮기기VB(A) 2024. 4. 17. 20:56
폴더를 선택하면
폴더 안의 하위 폴더도 모두 순환하며
최초 선택한 폴더로 파일을 모두 옮긴 후 폴더는 삭제하는 코드
파일명이 중복될 경우 난수를 생성해준다.
뤼튼 만세 ㅋㅋㅋ
Sub MoveFilesInSelectedFolder() Dim sourceFolder As String Dim destFolder As String Dim fso As Object Dim sourceFolderObj As Object Dim destFolderObj As Object Dim subFolder As Object Dim file As Object Dim fileName As String, newFileName As String Dim fileExists As Boolean Dim rndNumber As Integer ' 대화창을 열어 사용자로부터 폴더 선택 With Application.FileDialog(msoFileDialogFolderPicker) .Title = "폴더 선택" .AllowMultiSelect = False If .Show = -1 Then sourceFolder = .SelectedItems(1) Else Exit Sub End If End With destFolder = sourceFolder ' 파일 시스템 개체 생성 Set fso = CreateObject("Scripting.FileSystemObject") Set sourceFolderObj = fso.GetFolder(sourceFolder) Set destFolderObj = fso.GetFolder(destFolder) ' 모든 하위 폴더와 파일에 대해 순환 For Each subFolder In sourceFolderObj.SubFolders ' 하위 폴더 내의 파일에 대해 순환 For Each file In subFolder.Files fileName = file.Name fileExists = fso.fileExists(destFolder & "\" & fileName) If fileExists Then ' 파일명 중복 시 난수 추가 rndNumber = Int((9999 - 1000 + 1) * Rnd + 1000) newFileName = fso.GetBaseName(fileName) & "_" & rndNumber & "." & fso.GetExtensionName(fileName) Else newFileName = fileName End If ' 파일 이동 file.Move destFolder & "\" & newFileName Next file ' 하위 폴더 내의 하위 폴더에 대해 재귀적으로 호출 MoveFilesInSubFolders subFolder.Path, destFolder Next subFolder '빈 폴더 삭제 DeleteEmptyFolders sourceFolder End Sub Sub MoveFilesInSubFolders(ByVal folderPath As String, ByVal destFolder As String) Dim fso As Object Dim folder As Object Dim file As Object Dim subFolder As Object Dim fileName As String, newFileName As String Dim fileExists As Boolean Dim rndNumber As Integer Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(folderPath) For Each file In folder.Files fileName = file.Name fileExists = fso.fileExists(destFolder & "\" & fileName) If fileExists Then ' 파일명 중복 시 난수 추가 rndNumber = Int((9999 - 1000 + 1) * Rnd + 1000) newFileName = fso.GetBaseName(fileName) & "_" & rndNumber & "." & fso.GetExtensionName(fileName) Else newFileName = fileName End If ' 파일 이동 file.Move destFolder & "\" & newFileName Next file For Each subFolder In folder.SubFolders ' 재귀적으로 하위 폴더 내의 파일에 대해 호출 MoveFilesInSubFolders subFolder.Path, destFolder Next subFolder End Sub Sub DeleteEmptyFolders(ByVal folderPath As String) Dim fso As Object Dim folder As Object Dim subFolder As Object Dim isEmpty As Boolean Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(folderPath) ' 현재 폴더의 하위 폴더에 대해 재귀적으로 호출 For Each subFolder In folder.SubFolders DeleteEmptyFolders subFolder.Path Next subFolder ' 현재 폴더가 빈 폴더인지 확인 isEmpty = (folder.Files.Count = 0) And (folder.SubFolders.Count = 0) ' 빈 폴더일 경우 삭제 If isEmpty Then fso.DeleteFolder folder.Path End If End Sub
'VB(A)' 카테고리의 다른 글
키즈노트 일괄 다운로드 (0) 2024.04.26 당비휴 근무일지 달력 (0) 2023.02.10 시트 숨기기 일괄 처리 (2) 2021.04.19 공휴일 적용된 달력 (0) 2021.02.10 유효성검사 유일값 가져오기 (0) 2021.01.19 댓글