엑셀 VBA로 같은 폴더의 파일이름 추출하고 변경하는 소스코드(하위폴더 포함, name 사용하기)

엑셀 VBA에서 파일명을 변경하면 좋겠다고 생각을 해봤습니다.

그런데 폴더안에 폴더(서브폴더)에 접근하는데 고생을 좀 했습니다.

항상 코드를 짜고나서 다시 보면 쉽더라고요. 다음에도 사용하기 위해서 소스를 남겨 두겠습니다.

 

파일명 추출하기.xlsm

0.02MB

 

 

1. 소스 코드와 설명

 

'파일명 빼오기
Sub GetFileName()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim subfolder As Object
    Dim path As String
            
    path = ThisWorkbook.path '이 파일이 있는 경로를 추출합니다.
    fileNm = ThisWorkbook.Name '이 엑셀 파일의 이름입니다.
    
    Workbooks(fileNm).Worksheets("sheet1").Cells.Clear
    'Sheet1의 모든 내용을 전부 지웁니다.
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    '파일을 읽거나 쓸 수 있는 파일 시스템 오브젝트를 구성합니다.
    Set folder = fso.GetFolder(path)
	'폴더들의 경로를 저장합니다.
    
    For Each file In folder.Files 'Folder 배열내에 모든 파일이 끝날 때까지
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = path & "\" & file.Name
        Cells(Rows.Count, 8).End(xlUp).Offset(1, 0) = path & "\" & file.Name
        '한칸씩 내려가면서 파일명을 작성 똑같은리스트를 2번 만듭니다.
    Next file

    For Each subfolder In folder.subfolders
    'Subfoler들의 리스트를 엽니다.
        GetFile subfolder
    'GetFile 함수를 호출합니다.
    Next subfolder
End Sub



'------------------------------------------------------------------------------
'서브폴더의 파일명을 불러오는 소스
Sub GetFile(flder As Object)
    Dim file As Object
    Dim subfolder As Object
    
    path = flder
    '서브 폴더의 주소를 기록합니다.

    For Each file In flder.Files
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = path & "\" & file.Name
        Cells(Rows.Count, 8).End(xlUp).Offset(1, 0) = path & "\" & file.Name
        '똑같이 파일들을 불러옵니다.
    Next file

    For Each subfolder In flder.subfolders
        GetFile subfolder
        '하위폴더 안에 하위폴더가 있으면 다시 시작합니다. 여기가 핵심이네요.
    Next subfolder
End Sub

'------------------------------------------------------------------------------

'파일명 바꾸기
Sub Rename()
    Dim lastRow As Long
    Dim oldName As String
    Dim newName As String
    Dim path As String

    path = ThisWorkbook.path
    fileNm = ThisWorkbook.Name
    
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastRow - 1
    
        oldName = Cells(i + 1, 1).Value
        'A열에서 예전이름을 가져옴
        newName = Cells(i + 1, 8).Value
        'H열에 새로운 이름을 가져옵니다.
        If Right(oldName, Len(fileNm)) <> fileNm Then
        '파일명이 엑셀 파일명과 같으면 동작하지 않습니다.
            Name oldName As newName
           '파일병 변경하기
        End If
    Next i
End Sub

 

2. 코드의 동작 

 

 - 파일은 같은 폴더에 있도록 위치합니다.

 

 - 메크로 파일의 초기 모습니다. 파일이름을 불러오면 똑같은 리스트가 A와 H 열에 작성이 됩니다.

 

320x100

 

 

3. 파일이름 변경하기

 

수동으로 파일이름을 바꾸고 파일이름 변경하는 소스를 실행합니다.

파일이름이 바뀌는걸 확인했습니다.

 

4. 추가 팁

 

사용하는 열고 있는 파일명과 이름이 똑같으면 실행하지 않도록 합니다.

 

        If Right(oldName, Len(fileNm)) <> fileNm Then
            Name oldName As newName
        End If

 

엑셀은 실행중에 같은 폴더에 ~$"파일이름".xlsm이라는 임시파일을 형성합니다.

이건 접근이 안되서 그냥 동작시키면 오류가 납니다.

그걸 방지하기 위함이라고 보면 됩니다.