[Excel+VBA] 파일명 변경 매크로

지정한 폴더내의 파일명이나 확장자를 일괄로 변경하는 매크로입니다. 

윈도우용 유틸리티 중에 Rename-it 라는 프로그램을 자주 쓰는데 그 역할을 대신할 수 있습니다.

(사실은 지식인에 답변 올렸다가 완전히 묻혀버렸지만 나중에 쓸 데가 있을 것 같아 올려놓습니다. )

 

 

 

'파일목록가져오기' 버튼을 눌러서 폴더를 지정하면

일단 폴더의 파일을 검색해서 출력합니다. 
그 다음 일괄변경시키도록 했습니다.

 

새로운 파일명에 엑셀 수식을 이용해서 일괄적인 규칙을 부여할 때 유용하겠습니다. 
그리고 파일명과 확장자를 분리하였습니다.

예를 들어 파일명 뒤에 "_1" 같은 것을 일괄로 붙여서 변경하는 상황을 가정한다면 

수식을 이용해서 D3에 =B3 & "_1" 이런 식으로 바꾸고 아래로 끝까지 드래그해줍니다.

그리고 나서 '이름변경시작' 버튼을 눌러줍니다.

우측에는 변경 결과를 출력합니다.

이미 파일이 있는 경우나 기타 경우에 대해서는 오류를 출력해줍니다.

 

매크로는 아래와 같습니다.

'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

 

 

엑셀 수식을 이용하면 무궁무진한 활용이 가능하겠습니다.

네자리 숫자를 붙인다든지, 확장자를 앞 세자리만 가져온다든지, 

 

추가로 VBA를 조금 수정해서 이용하면 다른 변경도 가능하겠습니다.

MP3파일의 경우 ID3 Tag 에 따라서 파일명을 변경할 수도 있습니다.

참고: 지식인 링크 

 

FileSystemObject를 사용했으므로

Alt-F11 도구-참조에서 해당 라이브러리(Microsoft Scripting Engine)에 체크해줘야 합니다.

(CreateObject로 바꿔주면 되는데 소스입력할 때는 이게 편합니다.)

 

샘플 첨부합니다.

 

 

출처: https://konahn.tistory.com/entry/rename [konahn:티스토리]