VBA code to rename all files in a folder with another file extension

Excelpromax123

Board Regular
Joined
Sep 2, 2021
Messages
72
Office Version
  1. 2010
Platform
  1. Windows
Hello everyone. I need a code to rename the file extension of all files in a specified directory to another filename. Example: *abc
Illustration: rename the file extension of all files ( *xls,xlsx, xlsb, txt, docx, exe, JPG,png..Any file extension ) of the path "C:\Users\PC\ Desktop\TEST" change the file extension to *ABC
Note: If in the path "C:\Users\PC\ Desktop\TEST" there is a subfolder and there are files inside, it will also change the file extension to *ABC
Sincerely thank
1632885543879.png
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
2,006
Office Version
  1. 2016
Platform
  1. Windows
Create a macro workbook and copy this macro
VBA Code:
Option Compare Text

Sub CopySheetToClosedWB()

LoopAllFolderAndSub ("C:\Users\PC\ Desktop\TEST\")

End Sub

Sub LoopAllFolderAndSub(ByVal FPath As String)

Dim FName As String, FullFPath As String, Folds() As String, FileNoExt As String
Dim i As Long, nFold As Long
Dim wb As Workbook, wbPrg As Workbook

Set wbPrg = ActiveWorkbook

Application.ScreenUpdating = False

If Right(FPath, 1) <> "\" Then FPath = FPath & "\"
FName = Dir(FPath & "*.*", vbDirectory)

While Len(FName) <> 0
    If Left(FName, 1) <> "." Then
        FullFPath = FPath & FName
        If (GetAttr(FullFPath) And vbDirectory) = vbDirectory Then
            ReDim Preserve Folds(0 To nFold) As String
            Folds(nFold) = FullFPath
            nFold = nFold + 1
        Else
            FileNoExt = Left(FullFPath, InStrRev(FullFPath, ".") - 1)
            Name FullFPath As FileNoExt & ".ABC"
        End If
    End If
    FName = Dir()
Wend

For i = 0 To nFold - 1
    LoopAllFolderAndSub Folds(i)
Next i
wbPrg.Close False

End Sub
 

Excelpromax123

Board Regular
Joined
Sep 2, 2021
Messages
72
Office Version
  1. 2010
Platform
  1. Windows
The code runs very well. thank you. In case I want to change the name of the file, where should I edit the code in ascending order?
after renaming the file extension to "*.ABC", then continue to rename the file to data1, data2...so as not to have the same name
Eg:
1633089773318.png
 

Excelpromax123

Board Regular
Joined
Sep 2, 2021
Messages
72
Office Version
  1. 2010
Platform
  1. Windows
Create a macro workbook and copy this macro
VBA Code:
Option Compare Text

Sub CopySheetToClosedWB()

LoopAllFolderAndSub ("C:\Users\PC\ Desktop\TEST\")

End Sub

Sub LoopAllFolderAndSub(ByVal FPath As String)

Dim FName As String, FullFPath As String, Folds() As String, FileNoExt As String
Dim i As Long, nFold As Long
Dim wb As Workbook, wbPrg As Workbook

Set wbPrg = ActiveWorkbook

Application.ScreenUpdating = False

If Right(FPath, 1) <> "\" Then FPath = FPath & "\"
FName = Dir(FPath & "*.*", vbDirectory)

While Len(FName) <> 0
    If Left(FName, 1) <> "." Then
        FullFPath = FPath & FName
        If (GetAttr(FullFPath) And vbDirectory) = vbDirectory Then
            ReDim Preserve Folds(0 To nFold) As String
            Folds(nFold) = FullFPath
            nFold = nFold + 1
        Else
            FileNoExt = Left(FullFPath, InStrRev(FullFPath, ".") - 1)
            Name FullFPath As FileNoExt & ".ABC"
        End If
    End If
    FName = Dir()
Wend

For i = 0 To nFold - 1
    LoopAllFolderAndSub Folds(i)
Next i
wbPrg.Close False

End Sub


The code only works well with the file name in English, other languages the code cannot run. Please fix the code to run all languages
Please help me edit the code. Sincerely thank
1633091069274.png
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
2,006
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Can make it in one go like this
VBA Code:
Sub LoopAllFolderAndSub(ByVal FPath As String)

Dim FName As String, FullFPath As String, Folds() As String, FileNoExt As String
Dim i As Long, m As Long, nFold As Long
Dim wb As Workbook, wbPrg As Workbook

Set wbPrg = ActiveWorkbook

Application.ScreenUpdating = False

If Right(FPath, 1) <> "\" Then FPath = FPath & "\"
FName = Dir(FPath & "*.*", vbDirectory)

m = 0
While Len(FName) <> 0
    If Left(FName, 1) <> "." Then
        FullFPath = FPath & FName
        If (GetAttr(FullFPath) And vbDirectory) = vbDirectory Then
            ReDim Preserve Folds(0 To nFold) As String
            Folds(nFold) = FullFPath
            nFold = nFold + 1
        Else
            m = m + 1
            Name FullFPath As FPath & "Data" & m & ".ABC"
        End If
    End If
    FName = Dir()
Wend

For i = 0 To nFold - 1
    LoopAllFolderAndSub Folds(i)
Next i
wbPrg.Close False

End Sub
 

Excelpromax123

Board Regular
Joined
Sep 2, 2021
Messages
72
Office Version
  1. 2010
Platform
  1. Windows
Can make it in one go like this
VBA Code:
Sub LoopAllFolderAndSub(ByVal FPath As String)

Dim FName As String, FullFPath As String, Folds() As String, FileNoExt As String
Dim i As Long, m As Long, nFold As Long
Dim wb As Workbook, wbPrg As Workbook

Set wbPrg = ActiveWorkbook

Application.ScreenUpdating = False

If Right(FPath, 1) <> "\" Then FPath = FPath & "\"
FName = Dir(FPath & "*.*", vbDirectory)

m = 0
While Len(FName) <> 0
    If Left(FName, 1) <> "." Then
        FullFPath = FPath & FName
        If (GetAttr(FullFPath) And vbDirectory) = vbDirectory Then
            ReDim Preserve Folds(0 To nFold) As String
            Folds(nFold) = FullFPath
            nFold = nFold + 1
        Else
            m = m + 1
            Name FullFPath As FPath & "Data" & m & ".ABC"
        End If
    End If
    FName = Dir()
Wend

For i = 0 To nFold - 1
    LoopAllFolderAndSub Folds(i)
Next i
wbPrg.Close False

End Sub

The code runs very well. But Code only works well with English names, because I have many files with Chinese and Japanese languages, so the code cannot run. Please help me fix the code that works fine on all files regardless of language. Sincerely thank
1633102017522.png
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
2,006
Office Version
  1. 2016
Platform
  1. Windows
Oh... I forget about the other requirement you mentioned.

The problem is caused VBA not supporting unicode. I think the way to solve this is by calling Windows script. Try if this works
VBA Code:
Public n As Long

Sub RenameFileInFolderAndSbbFolder()

Dim FSO As Object
Dim FSOFolder As Object
Dim FoldName As String

Set FSO = CreateObject("Scripting.FileSystemObject")

'Set Folder Path here
FoldName = "C:\Users\MrExcel\Test\"

LoopSubFolder FSO.GetFolder(FoldName)

End Sub

Sub LoopSubFolder(FSOFolder As Object)

Dim FName As String
Dim FSO As Object
Dim FSOSubFolder As Object
Dim FSOFile As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each FSOSubFolder In FSOFolder.Subfolders
    LoopSubFolder FSOSubFolder
Next

' Rename Files
For Each FSOFile In FSOFolder.Files
    n = n + 1
    Name FSOFile As FSO.GetFolder(FSOFolder) & "\" & "Data" & n & ".ABC"
Next

End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,564
Messages
5,770,881
Members
425,648
Latest member
Danielle Wu

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
Top