📂 엑셀 VBA로 폴더 안 파일 자동 분류하기 – 팀/파트별로 자동 이동!
반복되는 파일 정리, 지치지 않으셨나요?
업무를 하다 보면
다양한 부서나 팀에서 만든 수많은 파일을
"이름을 보고 하나하나 폴더에 넣는" 일을 자주 하게 됩니다.
예를 들어, 아래처럼 된 파일들이 수십~수백 개 있다고 해볼게요:
기획_전략_이순신.xlsx 디자인-UX-김유신.pdf 마케팅 콘텐츠 박지성.hwp 개발.백엔드.장보고.pptx
이걸 하나하나 폴더를 만들고 정리한다면?
시간 낭비는 물론, 실수도 많고 지칩니다.
그래서 준비했습니다.
📌 엑셀 VBA 매크로로 자동 분류하는 방법은?
이 매크로는
파일명을 분석해서 \팀\파트\파일명 구조로 자동 정리해주는 도구입니다.
✅ 작동 방식:
- 파일명에서 팀과 파트를 자동으로 인식합니다
- _, -, 공백, . 구분자 모두 허용
- 예: 기획_전략_파일명 → 기획\전략\파일명
- 해당 폴더가 없으면 자동 생성
- 같은 이름 파일이 있으면 자동으로 (1), (2) 붙여 저장
- 모든 확장자(.xlsx, .pptx, .pdf 등) 지원
- 드라이브 간 이동도 안전하게 처리
✅ 예시:
📁 기획 └ 📁 전략 └ 이순신.xlsx 📁 디자인 └ 📁 UX └ 김유신.pdf
❓ 자주 묻는 질문
Q. 파일명이 완전히 규칙적이지 않아도 되나요?
A. 어느 정도 규칙만 있으면 됩니다.
구분자는 _, -, 공백, . 등을 모두 자동 인식합니다.
Q. 이름 중에 한글/영문/숫자 모두 사용 가능한가요?
A. 예, 유니코드 안전하게 처리됩니다.
Q. 기존 폴더나 파일과 겹치면 어떻게 되나요?
A. 같은 파일명이 있으면 (1), (2) 자동 넘버링되어 저장됩니다.
⚙️ 사용 방법
- Alt + F11 → 엑셀 VBA 편집기 실행
- 새 모듈 삽입 → 위 코드 전체 붙여넣기
- F5 또는 단축키로 OrganizeFilesByTeamPart 실행
- 정리할 폴더를 선택하면 끝!
VBA 코드
| Option Explicit '========================================================== ' \팀\파트\파일 구조로 분류/이동 (v3-all-clean: 로그 제거) ' - 파일명 규칙: 팀_파트_이름.* / 팀-파트-이름.* / "팀 파트 이름.*" / 점(.)도 허용 ' - 확장자 구분 없음: 모든 파일 이동 ' - 이동: FSO.MoveFile (드라이브 간/유니코드 안정) '========================================================== Public Sub OrganizeFilesByTeamPart() On Error GoTo EH Dim rootFolder As String: rootFolder = PickFolder("정리할 폴더를 선택하세요") If Len(rootFolder) = 0 Then Exit Sub If Right$(rootFolder, 1) <> "\" Then rootFolder = rootFolder & "\" Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(rootFolder) Then MsgBox "폴더가 없습니다: " & rootFolder: Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False Dim f As Object Dim team As String, part As String Dim destTeam As String, destPart As String Dim destFileFull As String For Each f In fso.GetFolder(rootFolder).Files If ParseTeamPartFlexible(f.Name, team, part) Then team = SafeFolderName(team): If Len(team) = 0 Then team = "팀미정" part = SafeFolderName(part): If Len(part) = 0 Then part = "파트미정" destTeam = rootFolder & team & "\" destPart = destTeam & part & "\" If EnsureFolderDeepFSO(fso, destTeam) And EnsureFolderDeepFSO(fso, destPart) Then destFileFull = GetUniquePathFSO(fso, destPart, f.Name) If IsValidPath(destFileFull) Then If StrComp(NormalizePath(f.Path), NormalizePath(destFileFull), vbTextCompare) <> 0 Then On Error Resume Next fso.MoveFile f.Path, destFileFull Err.Clear On Error GoTo EH End If End If End If End If Next f Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "정리 완료!", vbInformation Exit Sub EH: Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "오류: " & Err.Number & " - " & Err.Description, vbExclamation End Sub '---------------------------- 파서 ---------------------------- Private Function ParseTeamPartFlexible(ByVal fileName As String, _ ByRef team As String, ByRef part As String) As Boolean Dim base As String: base = GetFileNameNoExt(fileName) Dim s As String: s = Trim$(base) ' 구분자 통합: -, 공백, 탭, 점(.) → _ s = Replace(Replace(Replace(Replace(s, "-", "_"), " ", "_"), vbTab, "_"), ".", "_") Dim toks As Variant: toks = Split(s, "_") If IsArray(toks) Then If UBound(toks) >= 1 Then team = Trim$(toks(0)) part = Trim$(toks(1)) ParseTeamPartFlexible = (Len(team) > 0 And Len(part) > 0) End If End If End Function '---------------------------- 파일/폴더 유틸 (FSO 버전) ---------------------------- Private Function EnsureFolderDeepFSO(ByVal fso As Object, ByVal folderPath As String) As Boolean On Error GoTo EH Dim p As String: p = folderPath If Right$(p, 1) = "\" Then p = Left$(p, Len(p) - 1) If Len(p) = 0 Then EnsureFolderDeepFSO = False: Exit Function Dim parts() As String, i As Long, acc As String parts = Split(p, "\") If IsUNCPath(p) Then If UBound(parts) < 3 Then EnsureFolderDeepFSO = True: Exit Function ' \\server\share acc = "\\" & parts(2) & "\" & parts(3) If Not fso.FolderExists(acc) Then fso.CreateFolder acc For i = 4 To UBound(parts) acc = acc & "\" & parts(i) If Not fso.FolderExists(acc) Then fso.CreateFolder acc Next i Else acc = parts(0) For i = 1 To UBound(parts) acc = acc & "\" & parts(i) If Not fso.FolderExists(acc) Then fso.CreateFolder acc Next i End If EnsureFolderDeepFSO = True Exit Function EH: EnsureFolderDeepFSO = False End Function Private Function GetUniquePathFSO(ByVal fso As Object, ByVal baseFolder As String, ByVal fileName As String) As String If Right$(baseFolder, 1) <> "\" Then baseFolder = baseFolder & "\" Dim nameNoExt As String: nameNoExt = GetFileNameNoExt(fileName) Dim ext As String: ext = GetFileExt(fileName) Dim tryPath As String: tryPath = baseFolder & nameNoExt & IIf(ext <> "", "." & ext, "") If Not fso.FileExists(tryPath) Then GetUniquePathFSO = tryPath: Exit Function End If Dim n As Long: n = 1 Do tryPath = baseFolder & nameNoExt & " (" & n & ")" & IIf(ext <> "", "." & ext, "") If Not fso.FileExists(tryPath) Then GetUniquePathFSO = tryPath: Exit Function n = n + 1 Loop End Function Private Function GetFileExt(ByVal fileName As String) As String Dim p As Long: p = InStrRev(fileName, ".") If p > 0 Then GetFileExt = Mid$(fileName, p + 1) Else GetFileExt = "" End Function Private Function GetFileNameNoExt(ByVal fileName As String) As String Dim p As Long: p = InStrRev(fileName, ".") If p > 0 Then GetFileNameNoExt = Left$(fileName, p - 1) Else GetFileNameNoExt = fileName End Function Private Function SafeFolderName(ByVal s As String) As String Dim bad As Variant, i As Long bad = Array("\", "/", ":", "*", "?", """", "<", ">", "|") For i = LBound(bad) To UBound(bad) s = Replace$(s, bad(i), " ") Next s = Trim$(s) Do While Len(s) > 0 And (Right$(s, 1) = "." Or Right$(s, 1) = " ") s = Left$(s, Len(s) - 1) Loop ' 예약 장치명 회피 Dim dev As Variant dev = Array("CON", "PRN", "AUX", "NUL", _ "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", _ "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9") For i = LBound(dev) To UBound(dev) If StrComp(s, CStr(dev(i)), vbTextCompare) = 0 Then s = s & "_" Next SafeFolderName = s End Function Private Function NormalizePath(ByVal p As String) As String If Right$(p, 1) = "\" Then p = Left$(p, Len(p) - 1) NormalizePath = p End Function Private Function IsValidPath(ByVal p As String) As Boolean IsValidPath = True If Len(p) > 259 Then IsValidPath = False: Exit Function If Len(p) > 0 Then If Right$(p, 1) = "." Or Right$(p, 1) = " " Then IsValidPath = False End If End Function Private Function IsUNCPath(ByVal p As String) As Boolean IsUNCPath = (Len(p) >= 2 And Left$(p, 2) = "\\") End Function '---------------------------- 폴더 선택 ---------------------------- Private Function PickFolder(ByVal title As String) As String With Application.FileDialog(msoFileDialogFolderPicker) .title = title .AllowMultiSelect = False If .Show = -1 Then PickFolder = .SelectedItems(1) Else PickFolder = "" End With End Function |
✨ 이런 분께 강력 추천합니다
- 팀 파일을 체계적으로 정리하고 싶은 분
- 문서 자동 분류 시스템이 필요한 관리자
- 보고서, 자료, 산출물이 많은 부서 담당자
- 매번 수작업으로 정리하다 지친 실무자
✅ 마무리 요약
기능설명
| 파일 정리 기준 | 팀_파트_이름.* 형식 |
| 자동 생성 폴더 | 팀\파트 구조로 생성 |
| 파일 처리 방식 | 이동 (MoveFile 사용) |
| 지원 확장자 | 제한 없음 (모든 파일) |
이 매크로 하나면,
1초 만에 수백 개의 파일을 체계적으로 정리할 수 있습니다.
📬 실무 자동화 VBA 매크로, 더 받아보고 싶으신가요?
👉 블로그 구독하고 최신 매크로 예제 받아보기