지정한 폴더내의 파일명이나 확장자를 일괄로 변경하는 매크로입니다.
윈도우용 유틸리티 중에 Rename-it 라는 프로그램을 자주 쓰는데 그 역할을 대신할 수 있습니다.
(사실은 지식인에 답변 올렸다가 완전히 묻혀버렸지만 나중에 쓸 데가 있을 것 같아 올려놓습니다. )
'파일목록가져오기' 버튼을 눌러서 폴더를 지정하면
일단 폴더의 파일을 검색해서 출력합니다.
그 다음 일괄변경시키도록 했습니다.
새로운 파일명에 엑셀 수식을 이용해서 일괄적인 규칙을 부여할 때 유용하겠습니다.
그리고 파일명과 확장자를 분리하였습니다.
예를 들어 파일명 뒤에 "_1" 같은 것을 일괄로 붙여서 변경하는 상황을 가정한다면
수식을 이용해서 D3에 =B3 & "_1" 이런 식으로 바꾸고 아래로 끝까지 드래그해줍니다.
그리고 나서 '이름변경시작' 버튼을 눌러줍니다.
우측에는 변경 결과를 출력합니다.
이미 파일이 있는 경우나 기타 경우에 대해서는 오류를 출력해줍니다.
매크로는 아래와 같습니다.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | 'Alt-F11 도구-참조에서 Microsoft Scripting Engine 에 체크 Option Explicit Sub GetFileList() Dim Sht As Worksheet Dim FSO As FileSystemObject Dim oFolder As Folder Dim oFile As File Dim r As Long Dim SPR As String SPR = Application.PathSeparator Set Sht = ActiveSheet ChDir ThisWorkbook.Path & SPR '기본 폴더 With Application.FileDialog(msoFileDialogFolderPicker) .Show If .SelectedItems.Count = 0 Then Exit Sub Sht.Range("B1") = .SelectedItems(1) & SPR End With Sht.UsedRange.Offset(2).ClearContents '기존 내용 삭제 Set FSO = New FileSystemObject Set oFolder = FSO.GetFolder(Range("B1")) For Each oFile In oFolder.Files r = Sht.Cells(Sht.Rows.Count, 2).End(xlUp).Row + 1 Sht.Cells(r, 1) = r - 2 'Sht.Cells(r, 2) = Left(oFile.Name, InStrRev(oFile.Name, ".") - 1) Sht.Cells(r, 2) = FSO.GetBaseName(oFile.Name) 'Sht.Cells(r, 3) = Mid(oFile.Name, InStrRev(oFile.Name, ".") + 1) Sht.Cells(r, 3) = FSO.GetExtensionName(oFile.Name) Sht.Cells(r, 4).Formula = "=B" & r '& "&""_1""" ' 1.jpg -> 1_1.jpg Sht.Cells(r, 5).Formula = "=C" & r Next oFile Set FSO = Nothing End Sub Sub RenameFiles() Dim Sht As Worksheet Dim FSO As FileSystemObject Dim lastRow As Long Dim F1 As String, F2 As String Dim rng As Range Dim SPR As String SPR = Application.PathSeparator Set Sht = ActiveSheet lastRow = Sht.Cells(Sht.Rows.Count, 2).End(xlUp).Row Set FSO = New FileSystemObject On Error Resume Next For Each rng In Sht.Range("B3", Cells(lastRow, 2)) F1 = Sht.Range("B1") & rng & "." & rng.Offset(, 1) F2 = Sht.Range("B1") & rng.Offset(, 2) & "." & rng.Offset(, 3) If Not FSO.FileExists(F1) Then rng.Offset(, 4) = "-> Err: F1 not found!" ElseIf FSO.FileExists(F2) Then rng.Offset(, 4) = "-> Err: F2 exists!" Else FSO.MoveFile F1, F2 If Err.Number = 0 Then rng.Offset(, 4) = "-> Success" _ Else rng.Offset(, 4) = Err.Description End If Next rng On Error GoTo 0 Set FSO = Nothing End Sub | cs |
엑셀 수식을 이용하면 무궁무진한 활용이 가능하겠습니다.
네자리 숫자를 붙인다든지, 확장자를 앞 세자리만 가져온다든지,
추가로 VBA를 조금 수정해서 이용하면 다른 변경도 가능하겠습니다.
MP3파일의 경우 ID3 Tag 에 따라서 파일명을 변경할 수도 있습니다.
참고: 지식인 링크
FileSystemObject를 사용했으므로
Alt-F11 도구-참조에서 해당 라이브러리(Microsoft Scripting Engine)에 체크해줘야 합니다.
(CreateObject로 바꿔주면 되는데 소스입력할 때는 이게 편합니다.)
샘플 첨부합니다.
'XLS+VBA' 카테고리의 다른 글
네이버 지도 검색 결과 엑셀 수집 (121) | 2020.08.17 |
---|---|
VBA에서 Selenium 개체를 이용해서 웹 스크래핑 (14) | 2020.02.16 |
WordReference.com 사전 단어 자동 검색 및 MP3다운로드 (36) | 2019.12.24 |
[VB/VBA] WSOCK32.DLL이용한 주기적인 Ping 모니터링 (0) | 2019.06.06 |
초등학교 5학년 수학 문제를 엑셀 VBA로 (0) | 2019.01.18 |
[파싱]블러드앤소울 웹사이트 캐릭터별 능력치, 장비내역 파싱해서 가져오기 (5) | 2019.01.13 |
VBA로 RSS XML 데이터 읽어오기 (5) | 2018.12.19 |
Kospi200 종목별 주가를 JSon 데이터로 파싱해서 가져오기 (3) | 2018.11.24 |
최근댓글