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











LinkBack URL
About LinkBacks
Register To Reply

Bookmarks