출처 : 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 ======================================================================================
 

profile