Macro to rename files in a specific folder

[suricato]

http://www.mrexcel.com/forum/excel-questions/421519-macro-rename-files.html#post3838597

Hello Everybody,

I have following problem, discribed also in the link above.
I need a vba code to

- choose a folder instead of a file
- find all the files in the chosen folder with name that starts with "sz" and end with "_d"
- rename those files by replacing the first 5 numbers that follow sz with 5 different numbers that the user can choose e.g. through a user form.

I imagine the user to open the excel file, click on a form thats linked to a macro. The macro will call a userform and ask the user to choose the folder and type in a textbox the 5 new numbers.
I need the code that will be pasted behind the "OK" button in the userform.

Is this possible with <acronym title="visual basic for applications">vba</acronym>?
Thanks a lot for any kind of help!

Here a code i found in the link mentioned above, that i have applied and works - but needs to be modified to meet my needs:

Sub GetImportFileName()

Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As Variant

Dim newname As String


'Set up list of file filters
Filt = "All Files (*.*),*.*"

'Display *.* by default
FilterIndex = 1

'Set the dialog box caption
Title = "Select a file to rename and import"
'Get the file name
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)

'Exit if dialog box canceled
If FileName = False Then
MsgBox "No file was selected."
Exit Sub
End If

newname = Left(FileName, InStrRev(FileName, ".") - 1) & "_out.prt"
Name FileName As newname
'Display full path and name of the file
MsgBox "You selected" & FileName & Chr(10) & "it is renamed as " & newname


End Sub
​

 

[hippiehacker]

this looks like it would work

Sub LoopThroughFiles()
    Dim StrFile As String
    StrFile = Dir(GetFolder("C:\"))
    Do While Len(StrFile) > 0
       If UCase(Left(StrFile, 2)) = "SZ" And UCase(Mid(StrFile, InStr(1, StrFile, ".") - 2, 2)) = "_D" Then
        tmp = InputBox("Please put in your numbers.", "Number input")
        Name StrFile As Left(StrFile, 2) & tmp & Mid(StrFile, 8, Len(StrFile) - 8)
       End If
     StrFile = Dir
    Loop
End Sub

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem & "\"
Set fldr = Nothing
End Function

 

[suricato]

Thanks a lot for the help! The code doesn't work in the folder i choose yet, but i have good code to start with.