Macro to rename files in a specific folder

suricato

New Member
Joined
Jun 13, 2014
Messages
3
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

 
Last edited:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
this looks like it would work

Code:
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
 
Upvote 0
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. :)
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,700
Members
448,293
Latest member
jin kazuya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top