엑셀 매크로를 이용한 파일명 일괄변경

예전에 어디선가 보고 배워서 만들어서 잘 쓰던 매크로 입니다

다른 유틸리티 없이 엑셀 매크로를 이용하여 대량의 파일명을 쉽게 변환할 수 있습니다.

 

 

엑셀은 그림과 같이 만든 다음

매크로는 아래 표 읽어서 새로운 모듈추가해서 붙여넣기

Option Explicit Private Sub auto_close()     ThisWorkbook.Saved = True End Sub Private Sub Open_Filename()  '파일명 읽기 Dim lngCount As Long, lngI As Long Dim varArray As Variant, varArray2() As Variant Dim strPath As String     On Error GoTo er     varArray = Application.GetOpenFilename(Title:="파일들을 선택하세요.", MultiSelect:=True)     If TypeName(varArray) = "Boolean" Then Exit Sub     lngCount = UBound(varArray)     ReDim varArray2(1 To lngCount, 1 To 1)          '경로파악     strPath = CurDir(varArray(1)) & "\"          '파일명 파악     For lngI = 1 To lngCount       varArray2(lngI, 1) = Dir(varArray(lngI))     Next lngI          '경로 및 파일명 출력     Cells(3, 1) = "현재 경로 ▶ " & strPath     With Range("A6:B65536")       .ClearContents       .Interior.ColorIndex = xlNone     End With     Range(Cells(6, 1), Cells(lngCount + 5, 1)) = varArray2     MsgBox "파일명을 성공적으로 불러들였습니다." & vbCr & _       "변환작업을 진행하세요.", vbInformation     Exit Sub er:     MsgBox "에러가 발생하여 파일을 불러들이지 못했습니다.", vbInformation End Sub Private Sub Rename_Filename() '일괄변환 Dim lngRow As Long, lngI As Long, lngCount As Long, lngChk As Long Dim Fs As Object Dim strPath As String, strExt1 As String, strExt2 As String Dim varArray As Variant     On Error GoTo er     lngRow = Cells(65536, 1).End(xlUp).Row     If lngRow < 6 Then Exit Sub          Set Fs = CreateObject("Scripting.FileSystemObject")     strPath = Mid(Cells(3, 1), 6)     varArray = Range(Cells(6, 1), Cells(lngRow, 2)).Value     For lngI = 1 To lngRow - 5              If LenB(varArray(lngI, 1)) > 0 Then         If LenB(varArray(lngI, 2)) > 0 Then                    '확장자 비교           strExt1 = Fs.GetExtensionName(strPath & varArray(lngI, 1))           strExt2 = Fs.GetExtensionName(strPath & varArray(lngI, 2))                      If strExt1 = "" Or strExt1 = strExt2 Then             Name strPath & varArray(lngI, 1) As strPath & varArray(lngI, 2)             Range(Cells(lngI + 5, 1), Cells(lngI + 5, 2)).Interior.ColorIndex = 34             lngCount = lngCount + 1           ElseIf strExt2 = "" Then             Name strPath & varArray(lngI, 1) As strPath & varArray(lngI, 2) & "." & strExt1             Cells(lngI + 5, 2) = varArray(lngI, 2) & "." & strExt1             Range(Cells(lngI + 5, 1), Cells(lngI + 5, 2)).Interior.ColorIndex = 34             lngCount = lngCount + 1           Else             lngChk = MsgBox(varArray(lngI, 1) & " 파일의 변환확장자가 틀립니다." & vbCr & _               "그래도 변환할까요?", vbYesNoCancel)             If lngChk = vbYes Then               Name strPath & varArray(lngI, 1) As strPath & varArray(lngI, 2)               Range(Cells(lngI + 5, 1), Cells(lngI + 5, 2)).Interior.ColorIndex = 34               lngCount = lngCount + 1             ElseIf lngChk = vbCancel Then               MsgBox "변환작업이 취소되었습니다.", vbInformation               Exit Sub             End If           End If                    End If       End If     Next lngI     MsgBox "파일명을 일괄변환 하였습니다. (" & lngCount & "건)", vbInformation     Exit Sub er:     MsgBox "에러가 발생하여 변환을 완료하지 못했습니다.", vbInformation End Sub

 

① 파일명 읽기는 매크로 "Open_Filename()"과 연결

② 일괄변환은 매크로 "Rename_Filename()"과 연결

 

파일명 읽기 후 복수 파일 선택하면 A6셀부터 아래로 나열되며,

B6셀부터 바꿀 파일명을 입력후 일괄변환 클릭시 변환됩니다.

정상적인 변환이 되면 셀은 파란색으로 변경됩니다.

 

제 엑셀은 2016 버전입니다.  일반적인 명령어들이라 실행은 잘 될듯하네요.