출처 : SLR클럽자료실-초심자님
다운받기 : Exel_Macro_ChangeFileName.xls
이분이 매크로를 잘 사용하셔서..
나중에 매크로를 작성할때 레퍼런스로 사용할 요량으로 퍼옵니다.
폴더에서 파일의 리스트를 갖고 오고, 나중에 이름을 일괄 변경해주는 부분이 참 마음에 드는 군요.. ^-^;;
Macro Code ======================================================================================
Option Explicit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
Owner As Long
Root As Long
pszDisplayName As String
Title As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Function GetDirectory(Msg) As String
Dim bInfo As BROWSEINFO
Dim strPath As String
Dim r As Long
Dim x As Long
Dim intSpace As Integer
If IsMissing(Msg) Then
bInfo.Title = "대상 폴더를 선택하세요"
Else
bInfo.Title = Msg
End If
x = SHBrowseForFolder(bInfo)
strPath = Space(512)
r = SHGetPathFromIDList(ByVal x, ByVal strPath)
If r Then
intSpace = InStr(strPath, Chr(0)) '//chr(0)=" "
GetDirectory = Left(strPath, intSpace - 1) '//공백 앞까지 발췌
Else
GetDirectory = ""
End If
End Function
Sub 폴더선택()
Range("a3").ClearContents
파일이름읽기
End Sub
Sub 파일이름읽기()
Dim mydir, Mypath, FileExt, Msg As String
Dim fs As Object
Dim sFile As Variant
Dim i, s As Integer
If Range("a3").Value <> "" Then
mydir = Trim(Range("a3").Value)
Else
Msg = "대상 폴더를 선택하세요"
mydir = GetDirectory(Msg)
If mydir = "" Then Exit Sub
End If
s = Len(mydir)
FileExt = "*.*" '
Set fs = Application.FileSearch ' 지정 디렉토리에서 지정한 형식의 파일을 찾음
With fs
.NewSearch
.LookIn = mydir
.Filename = FileExt
.SearchSubFolders = False
.Execute
If .FoundFiles.Count = 0 Then ' 지정 디렉토리에 파일 없을땐 끝냄
MsgBox "디렉토리에 파일이 없습니다."
초기화
Exit Sub
End If
Range("a3:a5").ClearContents
Range("a11:c65536").ClearContents
Range("a3") = mydir
Range("a10").Select
For i = 1 To .FoundFiles.Count
sFile = .FoundFiles(i) ' 찾은 파일
Selection.Offset(i, 0) = Right(sFile, Len(sFile) - s - 1)
Selection.Offset(i, 1) = Right(sFile, Len(sFile) - s - 1)
Next i
End With
End Sub
Sub 초기화()
Range("a3:a7").ClearContents
Range("a11:c65536").ClearContents
Range("a3").Select
End Sub
Sub 다른이름저장()
Dim Oldname, NewName, mydir As String
Dim i, k, lastRow As Integer
If Trim(Range("a3").Value) = "" Then
초기화
Exit Sub
End If
k = 0
Cells(Cells.Rows.Count, 1).End(xlUp).Select
lastRow = Selection.Row - 9
mydir = Range("a3").Value
Range("a10").Select
With Selection
For i = 1 To lastRow - 1
Oldname = .Offset(i, 0).Value
NewName = .Offset(i, 1)
Oldname = mydir & "\" & Oldname
If NewName = "*" Then
Kill Oldname
ElseIf NewName = "" Then
Else
NewName = mydir & "\" & NewName
If NewName = Oldname Then
.Offset(i, 2) = "="
Else
Name Oldname As NewName
.Offset(i, 2) = "ok"
k = k + 1
End If
End If
Next i
End With
MsgBox k & "건 성공"
파일이름읽기
End Sub
Sub 바꿈()
If Range("a4").Value <> "" Then
Range("B11:B65536").Select
Selection.Replace What:=Range("a4").Value, Replacement:=Range("a5").Value, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
Range("a4:a5").ClearContents
Range("a4").Select
End Sub
Sub 기본바꿈()
Dim i, lastRow As Integer
Cells(Cells.Rows.Count, 5).End(xlUp).Select
lastRow = Selection.Row - 9
Range("B11:B65536").Select
For i = 1 To lastRow - 1
Selection.Replace What:=Cells(i + 10, 5).Value, Replacement:=Cells(i + 10, 6).Value, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
Range("a4").Select
End Sub
Sub 앞추가()
Dim i, lastRow As Integer
If Range("a6").Value <> "" Then
Cells(Cells.Rows.Count, 1).End(xlUp).Select
lastRow = Selection.Row - 9
Range("b10").Select
For i = 1 To lastRow - 1
If Selection.Offset(i, 0).Value <> "" Then
Selection.Offset(i, 0).Value = Range("a6").Value & Selection.Offset(i, 0).Value
End If
Next i
Range("a6").ClearContents
Range("a6").Select
End If
End Sub
Sub 뒤추가()
Dim i, k, n, lastRow As Integer
Dim imsi As String
On Error Resume Next
If Range("a6").Value <> "" Then
Cells(Cells.Rows.Count, 1).End(xlUp).Select
lastRow = Selection.Row - 9
Range("b10").Select
For i = 1 To lastRow - 1
If Selection.Offset(i, 0).Value <> "" Then
Err.Clear
imsi = ""
n = 1
k = 0
Do While Err = 0
k = Application.Find(".", Selection.Offset(i, 0), n)
n = k + 1
Loop
If n = 1 Then
imsi = Selection.Offset(i, 0).Value & Range("a6").Value
Else
imsi = Left(Selection.Offset(i, 0).Value, n - 2) & Range("a6").Value
imsi = imsi & Right(Selection.Offset(i, 0).Value, Len(Selection.Offset(i, 0).Value) - n + 2)
End If
Selection.Offset(i, 0).Value = imsi
End If
Next i
Range("a6").ClearContents
Range("a6").Select
End If
End Sub
Sub 뒤삭제()
Dim i, n, k, lastRow As Integer
Dim imsi As String
On Error Resume Next
If Range("a7").Value <> "" Then
Cells(Cells.Rows.Count, 1).End(xlUp).Select
lastRow = Selection.Row - 9
Range("b10").Select
For i = 1 To lastRow - 1
If Len(Selection.Offset(i, 0).Value) - Range("a7").Value > 1 Then
Err.Clear
imsi = ""
n = 1
k = 0
Do While Err = 0
k = Application.Find(".", Selection.Offset(i, 0), n)
n = k + 1
Loop
If n = 1 Then
imsi = Left(Selection.Offset(i, 0).Value, Len(Selection.Offset(i, 0).Value) - Range("a7").Value)
Else
imsi = Left(Selection.Offset(i, 0).Value, n - 2 - Range("a7").Value)
imsi = imsi & Right(Selection.Offset(i, 0).Value, Len(Selection.Offset(i, 0).Value) - n + 2)
End If
Selection.Offset(i, 0).Value = imsi
End If
Next i
Range("a7").ClearContents
Range("a7").Select
End If
End Sub
Sub 앞삭제()
Dim i, lastRow As Integer
Dim imsi As String
If Range("a7").Value <> "" Then
Cells(Cells.Rows.Count, 1).End(xlUp).Select
lastRow = Selection.Row - 9
Range("b10").Select
For i = 1 To lastRow - 1
If Len(Selection.Offset(i, 0).Value) - Range("a7").Value > 1 Then
imsi = ""
imsi = Right(Selection.Offset(i, 0).Value, Len(Selection.Offset(i, 0).Value) - Range("a7").Value)
Selection.Offset(i, 0).Value = imsi
End If
Next i
Range("a7").ClearContents
Range("a7").Select
End If
End Sub
Macro Code ======================================================================================