Hi Guys,
I worked really hard to get this solution. As I successfully completed it, so just sharing the code for your information and maybe improvement.
The function of this code is to RENAME the names of files based on their extension i.e. TXT, PDF, DOC etc in ANY folder chosen through a dialog box. You have to first used the routine "GetFileNames" to get all the file names in COLUMN-A of any empty excel sheet. Then do any formatting to the name of file in COLUMN-B (adjacent cells). Then you can rename the file names of COLUMN-A based on new names in COLUMN-B. Please don't change the full path or anything. Just change the ending part of file name (without path).
Regards and Cheers 
Option Explicit
Sub GetFileNames()
Dim fso As Object
Dim fPath As String
Dim myFolder, myFile
Dim r As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
End With
Set myFolder = fso.GetFolder(fPath).Files
r = 1
'Pick the file names based on certain extensions.
For Each myFile In myFolder
If LCase(myFile) Like "*.pdf" Then
ActiveCell.Offset(r) = myFile
r = r + 1
End If
Next myFile
End Sub
Sub Rename_Files()
Dim fso As Object
Dim fPath As String
Dim myFolder, myFile
Dim r As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
End With
Set myFolder = fso.GetFolder(fPath).Files
r = 1
'Change the file names based on adjacent column.
For Each myFile In myFolder
If LCase(myFile) Like "*.pdf" Then
Name Cells(r + 1, "A") As Cells(r + 1, "B")
r = r + 1
End If
Next myFile
End Sub
This code gonna make my life lot easier now on
Bookmarks