solution for How to rename files located in folder....

' This particular Code will fetch all the files in the given folder path
Function ShowFolderList(folderspec)
 Dim fso, f, f1, fc, s
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.GetFolder(folderspec)
 Set fc = f.Files
 fileCount=0
 For Each f1 in fc

 s = f1.name

' t1=split(s,"_")
 If instr(1,s,"_Date")>1 Then

  newName=  mid(s,1,Instr(1,s,"_Date")-1)
 
  f1.name=newName&".xls"
   Else
     newName = f1.name
 End If

 fileNames=fileNames&vbNewLine&s&"         "&newName&".xls"
 fileCount=fileCount+1
 Next
' fileNames=fileNames&vbNewLine&"------------------------------------------------"&vbNewLine&"Total Files in the folder: '"&folderspec&"' are : "&fileCount

 Set fOutput=fso.OpenTextFile("C:\ICAM\FileNames.txt",2,True)
 fOutput.Write "Total Files in the folder: '"&folderspec&"' are : "&fileCount&vbNewLine
 fOutput.Write "------------------FILE NAMES ARE------------------------------"
 fOutput.Write "-------Old File Name                 New File Name----------------------------"
 fOutput.Write fileNames
 Set fOutput=Nothing
 Set fso=Nothing
 MsgBox "File Names were successfully copied into file name: 'D:\FileNames.txt'"
End Function

folderspec=InputBox("Enter Folder Path")'"C:\Documents and Settings\719826\Local Settings\Temp"
Call ShowFolderList (folderspec)
'
't1 = "A3a-003_Date_6_2_2013_13_13.xls"
'msgbox mid(t1,1,Instr(1,t1,"_Date")-1)