SFA
03-27-2018, 04:39 AM
Dear,
I tried to rename automatically files. In Row A is the old Name and in Row b the new one. This works perfectly, but the code asks me every time to choose a folder. I just want to change this and the code should rename for example every File in the folder C:\test.
Since 3 weeks I try to change it, but I do not find an solution. At the moment I use the code:
Sub RenamesFiles()
Dim FilesDir As String
Dim CurFile As String
Dim RowNum As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
FilesDir = .SelectedItems(1)
CurFile = Dir(FilesDir & Application.PathSeparator & "*")
Do Until CurFile = ""
RowNum = 0
On Error Resume Next
RowNum = Application.Match(CurFile, Range("A:A"), 0)
On Error GoTo 0
If RowNum > 0 Then
Name FilesDir & Application.PathSeparator & CurFile As _
FilesDir & Application.PathSeparator & Cells(RowNum, "B").Value
End If
CurFile = Dir
Loop
End If
End With
End Sub
Kind regards
SFA
I tried to rename automatically files. In Row A is the old Name and in Row b the new one. This works perfectly, but the code asks me every time to choose a folder. I just want to change this and the code should rename for example every File in the folder C:\test.
Since 3 weeks I try to change it, but I do not find an solution. At the moment I use the code:
Sub RenamesFiles()
Dim FilesDir As String
Dim CurFile As String
Dim RowNum As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
FilesDir = .SelectedItems(1)
CurFile = Dir(FilesDir & Application.PathSeparator & "*")
Do Until CurFile = ""
RowNum = 0
On Error Resume Next
RowNum = Application.Match(CurFile, Range("A:A"), 0)
On Error GoTo 0
If RowNum > 0 Then
Name FilesDir & Application.PathSeparator & CurFile As _
FilesDir & Application.PathSeparator & Cells(RowNum, "B").Value
End If
CurFile = Dir
Loop
End If
End With
End Sub
Kind regards
SFA