G
Guest
I have a form that replaces filenames with others. Find1 and Replace1 are
textboxes which let you specify what to find and replace. A browse button lets
you choose the dir to do it on. Anyone know how to make it search
subdirectories? I want to replace all the .jpegs with .jpg and want to do my
entire C drive instead of searching all the individual folders. Some programs
still can't see .jpegs so I want to rename them.
Dim FN As String, MyPath As String
Dim name1 As String, name2 As String 'oldname newname
Dim F1 As String, F2 As String, R1 As String 'Find and replace vars
Dim T1 As String, T2 As String
Dim Tstart As Integer, Tend As Integer
'this is a button on a form with three textboxes
'for path, find, and replace criteria
MyPath = Me.TextBox1.Text 'path text box
FN = Dir(MyPath & "*.*")
F1 = Me.Find1.Text 'find textbox
F2 = "*" & Me.Find1.Text & "*" 'search criteria
R1 = Me.Replace1.Text 'replace textbox
Do Until FN = ""
Tstart = InStr(1, FN, F1, 1)
If FN Like (F2) Then
If Left(FN, Len(F1)) = F1 Then 'see if anything before criteria
T1 = ""
Else:
T1 = Left(FN, (Tstart - 1))
End If
T2 = Right(FN, Len(FN) - (Len(F1) + Len(T1)))
name1 = MyPath & FN
name2 = MyPath & T1 & R1 & T2
Name name1 As name2 'rename file
End If
FN = Dir
Loop
MsgBox "Done"
End Sub
(e-mail address removed)
textboxes which let you specify what to find and replace. A browse button lets
you choose the dir to do it on. Anyone know how to make it search
subdirectories? I want to replace all the .jpegs with .jpg and want to do my
entire C drive instead of searching all the individual folders. Some programs
still can't see .jpegs so I want to rename them.
Dim FN As String, MyPath As String
Dim name1 As String, name2 As String 'oldname newname
Dim F1 As String, F2 As String, R1 As String 'Find and replace vars
Dim T1 As String, T2 As String
Dim Tstart As Integer, Tend As Integer
'this is a button on a form with three textboxes
'for path, find, and replace criteria
MyPath = Me.TextBox1.Text 'path text box
FN = Dir(MyPath & "*.*")
F1 = Me.Find1.Text 'find textbox
F2 = "*" & Me.Find1.Text & "*" 'search criteria
R1 = Me.Replace1.Text 'replace textbox
Do Until FN = ""
Tstart = InStr(1, FN, F1, 1)
If FN Like (F2) Then
If Left(FN, Len(F1)) = F1 Then 'see if anything before criteria
T1 = ""
Else:
T1 = Left(FN, (Tstart - 1))
End If
T2 = Right(FN, Len(FN) - (Len(F1) + Len(T1)))
name1 = MyPath & FN
name2 = MyPath & T1 & R1 & T2
Name name1 As name2 'rename file
End If
FN = Dir
Loop
MsgBox "Done"
End Sub
(e-mail address removed)