[엑셀 VBA] 파일이름 바꾸기 클래스

작성자
dra****
작성일
2021-05-04 18:33
조회
53

미루고 미루고 미루다, 오늘 클래스 하나를 만들었습니다. 파일 이름 일괄 바꾸기 입니다.

수만개의 파일들을 일관성 있게 정리 했습니다. 엑셀 자동화의 매력 ... ㅎㅎㅎ

그 외에 몇가지 자동화에 도움이 될 만한 함수도 있습니다. ㅋ

워크시트 배열 상태
칼럼          "C"     |    "D"  |    "E"    |      "F"       |                    "G"                            |                      "H"
3행        원본폴더 | 파일명 |  확장자 | 바꿀파일명 |원본FullPath(수식창=C4 & D4 & E4)|바꿀파일명FullPath(수식창=C4 & F4 & E4)
4행        실제 파일명들이 들어 옵니다. 옵션을 주면 선택할 수 있습니다.

사용방법

	Option Explicit
 
	Private fnFso  As clsFSO
 
	Sub Set_clsFSO()
	   Set fnFso = New clsFSO
	End Sub
 
	Sub DeSet_clsFSO()
	   Set fnFso = Nothing
	End Sub
 
	Public Sub 파일이름시트에뿌리기()
	   Set_clsFSO
	   fnFso.FileNames_PopulateFileNamesToSheet "C:\temp", 4, "C", "D", "E"
	   DeSet_clsFSO
	End Sub
 
	Public Sub 파일이름바꾸기()
	   Set_clsFSO
	   fnFso.Filenames_Rename 4, "G", "H"
	   DeSet_clsFSO
	End Sub
 
	Public Sub 데이터영역지우기()
	   Set_clsFSO
	   fnFso.Sheet_RangeClear 4, "C", "F"
	   DeSet_clsFSO
	End Sub

클래스 소스 - Class명을 clsFSO로 지정

	Option Explicit
 
	Private RowNo              As Long
	Private RowLast            As Long
	Private fgExtDivide        As Boolean
 
 
	Public Sub FileNames_PopulateFileNamesToSheet(Optional startFolder As String = vbNullString, Optional RowStart As Long = 4, Optional ColFolder As String = "C", Optional ColFileName As String = "D", Optional ColExt As String = "E")
 
	'// 파일 다이얼로그 열을 때 검색을 시작 할 경로 - startFolder String = vbNullString
	'// 시트에 뿌릴 시작 행                         - Optional RowStart As Long = 4
	'// 폴더 경로를 뿌릴 칼럼 지정                  - Optional ColFolder As Variant = "C",
	'// 파일 이름을 뿌릴 칼럼 지정                  - Optional ColFileName As Variant = "D",
	'// 파일 확장자를 뿌를 칼럼 지정                - Optional ColExt As Variant = "E"
	'// 확장자를 뿌릴 칼럼이 지정 되면 파일이름과 확장자를 분리한다.
 
	   Dim srcFolder              As String
	   RowNo = RowStart
	   fgExtDivide = IIf(IsMissing(ColExt), False, True)
 
	   If startFolder = vbNullString Then
		  srcFolder = vbNullString
	   Else
		  srcFolder = startFolder
	   End If
	   srcFolder = OpenFolderPickerDialog(srcFolder)
	   If srcFolder = vbNullString Then Exit Sub
 
	   Application.ScreenUpdating = False
	   Call CreateFileNamesFromFolder(srcFolder, RowNo, ColFolder, ColFileName, ColExt)
	   Application.ScreenUpdating = True
	   MsgBox "파일 이름 가져오기 완료!!!", vbInformation
	End Sub
 
	'FileDialog를 호출하여 한 개의 폴더경로를 문자열로 반환한다.
	Public Function OpenFolderPickerDialog(Optional path As String) As String
	   Dim fso  As Scripting.FileSystemObject
	   Dim fd   As FileDialog
 
	   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
	   fd.InitialFileName = path
	   fd.Show
	   OpenFolderPickerDialog = IIf(fd.SelectedItems.Count <= 0, vbNullString, fd.SelectedItems(1))
	End Function
 
 
	'해당 폴더에 있는 하위 폴더 포험 모든 파일 이름 분해해서 시트에 뿌리기
	Private Sub CreateFileNamesFromFolder(ByVal scrFolder As String, _
									  Optional RowStart As Long, _
									  Optional ColFolder As String, _
									  Optional ColFileName As String, _
									  Optional ColExt As String)
 
	   Dim fso                    As Scripting.FileSystemObject
	   Dim Files                  As Files
	   Dim File                   As File
 
	   Dim Folders, SubFolders    As Folders
	   Dim Folder, SubFolder   As Folder
 
	   Set fso = New Scripting.FileSystemObject
	   Set Folder = fso.GetFolder(scrFolder)
	   Set Files = Folder.Files
 
	   If Files.Count > 0 Then
		  For Each File In Files
			 ActiveSheet.Cells(RowNo, ColFolder).Value = File.ParentFolder & "\"
			 If fgExtDivide = True Then
				ActiveSheet.Cells(RowNo, ColFileName).Value = fso.GetBaseName(File.Name)
				ActiveSheet.Cells(RowNo, "F").Value = fso.GetBaseName(File.Name)
				ActiveSheet.Cells(RowNo, ColExt).Value = GetExtensionWithDot(File.Name)
			 Else
				ActiveSheet.Cells(RowNo, ColFileName).Value = File.Name
			 End If
			 RowNo = RowNo + 1
		  Next File
	   End If
 
	   Set SubFolders = Folder.SubFolders
		  RowNo = RowNo + 1
		  If SubFolders.Count > 0 Then
			 RowNo = RowNo + 1
			 For Each SubFolder In SubFolders
				Call CreateFileNamesFromFolder(SubFolder, RowNo, ColFolder, ColFileName, ColExt)
			 Next
		  End If
	End Sub
 
	'파일 이름 바꾸기
	Public Sub Filenames_Rename(RowStart As Long, ColSource As String, ColReplace As String, Optional shName As String = vbNullString)
	   Dim src, dest As String
	   Dim i As Long
	   Dim sh As Worksheet
	   RowLast = GetLastRow(ColSource)
 
	   If shName = vbNullString Then
		  Set sh = ActiveSheet
	   Else
		  Set sh = Worksheets(shName)
	   End If
 
	   For i = RowStart To RowLast
		  src = Trim(sh.Cells(i, ColSource).Value)
		  dest = Trim(sh.Cells(i, ColReplace).Value)
 
		  If src = vbNullString Or dest = vbNullString Then
		  Else
			 Name src As dest
		  End If
	   Next
	   MsgBox "파일 이름 바꾸기 완료!!!", vbInformation
	End Sub
 
	'해당 범위의 내용 지우기
	Public Sub Sheet_RangeClear(RowStart As Long, ColStart As String, ColEnd As String)
	   RowLast = GetLastRow(ColStart)
	   Range(Cells(RowStart, ColStart), Cells(RowLast, ColEnd)).Clear
	   MsgBox "지정한 범위를 지웠습니다."
	End Sub
 
	'해당 범위 삭제
	Public Sub Sheet_RangeDelete(RowStart As Long, ColStart As String, ColEnd As String)
	   RowLast = GetLastRow(ColStart)
	   Range(Cells(RowStart, ColStart), Cells(RowLast, ColEnd)).Delete
	   MsgBox "지정한 범위를 지웠습니다."
	End Sub
 
 
	'폴더화 파일명이 있는 문자열에서 폴더 경로만 가져오기
	Public Function GetFolderPath(Folder As String) As String
	   GetFolderPath = IIf(IsNull(Folder), vbNullString, Left(Folder, InStrRev(Folder, "\")))
	End Function
 
	'폴더화 파일명이 문자열에서 파일이름(확장자포함) 가져오기
	Public Function GetFileNameFromFolderPath(Folder As String) As String
	   GetFileNameFromFolderPath = IIf(IsNull(Folder), vbNullString, Right(Folder, Len(Folder) - InStrRev(Folder, "\")))
	End Function
 
	'경로와 확장자 없이 파일 이름만 가져오기
	Public Function GetBaseName(FileName As String) As String
	   Dim fso As New Scripting.FileSystemObject
	   GetBaseName = IIf(IsNull(FileName), vbNullString, fso.GetBaseName(FileName))
	   Set fso = Nothing
	End Function
 
	' "."을 포함 확장자만 가져오기
	Public Function GetExtensionWithDot(FileName As String) As String
	   GetFileExtension = IIf(IsNull(FileName), vbNullString, Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1))
	End Function
 
	' "."이 없는 확장자만 가져오기
	Public Function GetExtensionWithoutDot(FileName As String) As String
	   Dim fso As New Scripting.FileSystemObject
	   GetExtensionWithoutDot = IIf(IsNull(FileName), vbNullString, fso.GetExtensionName(FileName))
	   Set fso = Nothing
	End Function
 
	'데이터가 있는 마지막 행번호 구하기
	Public Function GetLastRow(Col As Variant) As Long
	   GetLastRow = Cells(Cells.Rows.Count, Col).End(xlUp).Row
	End Function
 
	'데이터가 있는 마지막 열번호 구하기
	Public Function GetLastColumn(Row As Long) As Long
	   GetLastColumn= Cells(Row, Cells.Columns.Count).End(xlLeft).Column
	End Function

 

 

회원등급 : 가지2단계
포인트 : 565 EP
전체 4

  • 2021-05-04 19:34

    빠르게 잘 동작하네요 ㅎㅎ 평소 darknamer라는 프로그램 사용했는데

    이거 잘 응용하면 엑셀로 작업할 때 더 빠르게 할 수 있을 듯 합니다 ㅎㅎ 클래스모듈은 어려워서 다루지 못했는데 이렇게 사용하니 편리하네요.

    아래 테스트 한 파일 같이 첨부합니다..ㅎㅎ C:\Temp 폴더에 a.txt 라는 파일 넣으시고 버튼 누르면 b.txt 로 파일명 변경됩니다.

    Screenshot_4.png

    첨부파일 : 파일명바꾸기.xlsm


    • 2021-05-04 19:59

      fnFso.FileNames_PopulateFileNamesToSheet "C:\temp", 4, "C", "D", "E"

      "C:\temp"만 바꿔쭈시고 실행하면 하위 폴더까지 폴더명, 파일이름, 확장자 구별해서 다 넣어 줍니다. 그리고 "F"칼럼에 파일이름을 똑같이 다시 넣어 주는데 으를 수정하시면 "G", "H" 열에 원본파일, 바뀔파일이 자동에 생깁니다.


    • 2021-05-05 04:52

      실행해보니 정말 되는군요.. 신기합니다. 코드는 3줄인데 이 모든게 된다는게 놀랍네요.

      앞으로 모듈을 사용하면 다른파일 안에 클래스 모듈만 옮겨서 사용할 수 있는건가요?


      • 2021-05-05 04:57

        넵 가능합니다. 저는 오늘 4만개가 넘는 파일들을 10초도 안돼서 정리 했습니다. 앞으로 이런 클래스들 많이 올릴 계왹입니다. "오빠두"님이 싫어하지 않으신다면.


전체 375
번호 제목 작성자 작성일 추천 조회
331
New [변화의 물결] 오피스용 스크립트 랭귀지가 곧 도입될 것으로 보이네요. (2)
dra**** | 2021.05.13 | 추천 0 | 조회 25
dra**** 2021.05.13 0 25
330
New [엑셀 VBA] 콤보박스와 리스트박스에 마우스 췰 스크롤 기능 추가하기 첨부파일
dra**** | 2021.05.13 | 추천 0 | 조회 28
dra**** 2021.05.13 0 28
329
원숭이 신발 이야기 (3)
dra**** | 2021.05.11 | 추천 5 | 조회 39
dra**** 2021.05.11 5 39
328
저는 원래 수학을 못해요, 저는 원래 영어를 못해요 (1)
dra**** | 2021.05.11 | 추천 2 | 조회 56
dra**** 2021.05.11 2 56
327
[엑셀 VBA] 누군가의 시간과 노력을 거저 먹으려는 사름들의 패턴 (2)
dra**** | 2021.05.11 | 추천 1 | 조회 69
dra**** 2021.05.11 1 69
326
[엑셀 VBA] 따라다니며 도움을 주는 버튼 첨부파일
dra**** | 2021.05.10 | 추천 1 | 조회 59
dra**** 2021.05.10 1 59
325
[엑셀 VBA] 엑셀 함수 VS. VBA (4)
dra**** | 2021.05.10 | 추천 2 | 조회 52
dra**** 2021.05.10 2 52
324
[엑셀 VBA] shape 개체를 이용해 구현한 아날로그 시계 첨부파일 (6)
dra**** | 2021.05.08 | 추천 2 | 조회 63
dra**** 2021.05.08 2 63
323
추가기능 (사진 첨부 ) 이런건 없을까요? ^^ (2)
조문환 | 2021.05.07 | 추천 0 | 조회 58
조문환 2021.05.07 0 58
322
[건의사항] 게시판 추천, 조회 순으로 정렬 (2)
forforj**** | 2021.05.07 | 추천 1 | 조회 20
forforj**** 2021.05.07 1 20
321
매번 큰 도움을 받고 있습니다. (3)
조문환 | 2021.05.06 | 추천 3 | 조회 49
조문환 2021.05.06 3 49
320
[엑셀 VBA] 타이틀바 없는 모더니칼한 폼 만들기 (3)
dra**** | 2021.05.06 | 추천 1 | 조회 48
dra**** 2021.05.06 1 48
319
커뮤니티에 있는 자료 중 쇼핑몰 대시보드를 일반 가계부로~ (2)
bami | 2021.05.06 | 추천 0 | 조회 30
bami 2021.05.06 0 30
318
화창하고 즐거운 어린이날인데~~~~ 일함 ㅠㅠ (6)
Fainter | 2021.05.05 | 추천 3 | 조회 47
Fainter 2021.05.05 3 47
317
[엑셀 VBA] 바코드 만들기 (4)
dra**** | 2021.05.05 | 추천 1 | 조회 67
dra**** 2021.05.05 1 67
316
[엑셀 VBA] 학습에 대한 제언 (5)
dra**** | 2021.05.04 | 추천 2 | 조회 69
dra**** 2021.05.04 2 69
315
[엑셀 VBA] 파일이름 바꾸기 클래스 (4)
dra**** | 2021.05.04 | 추천 3 | 조회 53
dra**** 2021.05.04 3 53
314
항상 좋은 정보 감사합니다. (4)
jsr**** | 2021.05.02 | 추천 7 | 조회 41
jsr**** 2021.05.02 7 41
313
엑셀 예제 파일 첨부파일 (1)
코이노니아 | 2021.05.02 | 추천 0 | 조회 78
코이노니아 2021.05.02 0 78
312
XLOOKUP 함수 추가기능 설치후 문제 (1)
코이노니아 | 2021.05.02 | 추천 0 | 조회 38
코이노니아 2021.05.02 0 38
311
라이브강의 45회차 왜 없나여? (2)
용이 | 2021.05.02 | 추천 0 | 조회 32
용이 2021.05.02 0 32
310
환율조회 추가기능 설치 파일이 이상해요
늦게배운엑셀 | 2021.04.30 | 추천 0 | 조회 34
늦게배운엑셀 2021.04.30 0 34
309
오빠두에 뼈를 묻어 보렵니다! (3)
로니파 | 2021.04.30 | 추천 5 | 조회 51
로니파 2021.04.30 5 51
308
엑셀 열공 출석 체크 입니다. (3)
virot | 2021.04.29 | 추천 3 | 조회 51
virot 2021.04.29 3 51
307
안녕하세요 구글 클라우드 사용불가일때..모바일 (1)
해축만큼뉴스보자 | 2021.04.27 | 추천 0 | 조회 54
해축만큼뉴스보자 2021.04.27 0 54