+ Reply to Thread
Results 1 to 2 of 2

Rename files with a macro

Hybrid View

  1. #1
    Registered User
    Join Date
    01-13-2012
    Location
    Somerset, England
    MS-Off Ver
    Excel 2010
    Posts
    6

    Post Rename files with a macro

    I'm desperate to find/create a macro that will allow the user to specify a path to a folder that contains files... and then give a Find/replace form. This is the code I currently have, however this no longer works in 2007/2010 as Application.FileSearch is no longer an object.

    User Forms within the attachment.

    Book2.xlsm

    Sub FileRename()
     
    '   Renames files in any directory by finding and replacing certain areas of the filename
    
        'Basic config
        Dim i As Long
        Dim fred As String
        Dim john As String
    
        Workbooks.Add
        Range("A1:A1").Select
        Columns("A:A").ColumnWidth = 70
        Columns("B:B").ColumnWidth = 70
        Application.DisplayAlerts = False
        UserForm1.OptionButton1.Value = False
        
       
          
    '**************************************************************************************
    'ENTER THE NAME OF THE FOLDER WHERE THE FILES ARE TO BE RENAMED
        
        Call UserForm1.Show
        If UserForm1.OptionButton1.Value = True Then Exit Sub
    
        
    '**************************************************************************************
         
        'FINDS FILES IN THE FOLDER TO BE RENAMED
        With Application.FileSearch
            .NewSearch
            .LookIn = UserForm1.TextBox1.Value
            .Filename = "*.*"
            .SearchSubFolders = False
                    
            If .Execute() > 0 Then
                'CREATES THE FILE LIST IN A NEW WORKSHEET OF ALL FILES IN FOLDER
                Range("A1:A1").Select
                For i = 1 To .FoundFiles.Count
                    Cells(i, 1).Select
                    ActiveCell.Value = .FoundFiles(i)
                Next i
            Else
                'ERROR IF NO FILES ARE FOUND
                MsgBox "There are no files in the directory"
                ActiveWindow.Close
                Application.Run "PERSONAL.XLS!FileRename"
                Exit Sub
            End If
          
            Range("A1:A1").Select
            UserForm2.TextBox1.Value = ""
            UserForm2.TextBox2.Value = ""       'NULL ALL FIND & REPLACE VALUES
            UserForm2.TextBox3.Value = ""
            UserForm2.TextBox4.Value = ""
            
            Call UserForm3.Show
            If UserForm1.OptionButton1.Value = True Then
                ActiveWindow.Close
                Application.Run "PERSONAL.XLS!FileRename"
                Exit Sub
            End If
               
            'LISTS THE CONTENTS OF DIRECTORY WITH RENAME
            Columns("A:A").Select
            Selection.Copy
            Columns("B:B").Select
            ActiveSheet.Paste
            Columns("B:B").Select
            Selection.replace what:=UserForm2.TextBox1.Value, Replacement:=UserForm2.TextBox2.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False
            Selection.replace what:=UserForm2.TextBox3.Value, Replacement:=UserForm2.TextBox4.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False
            
            Columns("A:A").Select
            Call UserForm4.Show
            
            If UserForm4.OptionButton1.Value = True Then
                    
                If .Execute() > 0 Then
                    For i = 1 To .FoundFiles.Count
                        Cells(i, 1).Select
                        fred = ActiveCell.Value
                        Cells(i, 2).Select
                        john = ActiveCell.Value
                        Name fred As john                 'RENAMES PHYSICAL FILES
                    Next i
                    Range("A1:A1").Select
                    i = i - 1
                    MsgBox i & " files have been renamed"
                End If
            
            Else
            
                MsgBox "No files have been renamed"
                ActiveWindow.Close
                Application.Run "PERSONAL.XLS!FileRename"
                Exit Sub
                        
            End If
                   
          
        End With
        
        ActiveWindow.Close
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        
    End Sub

  2. #2
    Forum Expert
    Join Date
    07-15-2012
    Location
    Leghorn, Italy
    MS-Off Ver
    Excel 2010
    Posts
    3,431

    Re: Rename files with a macro

    this is an example to show the files
    Sub FileShow()
    '   Renames files in any directory by finding and replacing certain areas of the filename
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFolder("D:\DATI\prova\")
        Set fc = f.Files
        Range("A1:A1").Select
        Columns("A:A").ColumnWidth = 70
        Columns("B:B").ColumnWidth = 70
        i = 1
        For Each f1 In fc
        Cells(i, 1).Value = f1.Name
        i = i + 1
        Next
        
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1