Visual Basic Scripting: Rename all editable files in a folder with there first line of the document.

I found this VBS scripting helpful to do stuff with file names.

I tried to rename auto names of TEXT, JAVA, CSS etc files to rename with there first line of text, I got succeeded. 

Here is the code you need to do the task. 


Steps:

1. Copy paste this script to new file and save as *.VBS file.
2. Edit Folder path in the script.
3. Set the number of characters in the script.
4. Save the file once agian.
5. You are ready to roll out!!!!, go to the folder where the file is stored and just double click on it.


After some you will see all files names with there content of the file.

CODE:

'START
'Adapted from http://www.microsoft.com/technet/scriptcenter/resources/qanda/apr06/hey0404.mspx
 
strFolder = "C:\Users\pradeekumar\Documents\Notes"
intChars = 30
arrRemove = Array(chr(0),chr(1),chr(2),chr(3),chr(4),chr(5),chr(6),chr(7),chr(8),chr(9),chr(10),chr(11),chr(12),chr(13),chr(14),chr(15),chr(16),chr(17),chr(18),chr(19),chr(20),chr(21),chr(22),chr(23),chr(24),chr(25),chr(26),chr(27),chr(28),chr(29),chr(30),chr(31),chr(32),chr(33),chr(34),chr(35),chr(36),chr(37),chr(38),chr(39),chr(40),chr(41),chr(42),chr(43),chr(44),chr(45),chr(46),chr(47),chr(58),chr(59),chr(60),chr(61),chr(62),chr(63),chr(64),chr(91),chr(92),chr(93),chr(94),chr(96),chr(123),chr(124),chr(125),chr(126),chr(127))
 
On Error Resume Next
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
 
Set objWord = CreateObject("Word.Application")
 
Wscript.Echo arrRemove

For Each strFile in objFolder.Files
 'Wscript.Echo DateDiff("d",strFile.DateCreated,Now)
 'if DateDiff("d",strFile.DateCreated,Now) = 0 Then
  arrNames = Split(strFile.Name, ".")
  strExt = arrNames(UBound(arrNames))
  
  If LCase(strExt) = "css" OR LCase(strExt) = "text" OR LCase(strExt) = "java" OR LCase(strExt) = "text" OR LCase(strExt) = "js" Then
   Set objDoc = objWord.Documents.Open(strFile.Path)
   Set objRange = objDoc.Range(0,intChars*3)
   
   strRange = objRange.Text
   
   For Each strChar in arrRemove
    strRange = Replace(strRange, strChar, " ")
   Next
   
   ' convert tabs to spaces first
   strRange = Replace(strRange, vbTab, " ")

   ' convert all CRLFs to spaces
   strRange = Replace(strRange, vbCrLf, " ")
   
   ' Find and replace any occurences of multiple spaces
   Do While (InStr(strRange, "  "))
    ' if true, the string still contains double spaces,
    ' replace with single space
    strRange = Replace(strRange, "  ", " ")
   Loop
   
   strRange = Month(strFile.DateCreated) & "." & Day(strFile.DateCreated) &  " " &  strRange
      
   ' Remove any leading or training spaces and return
   ' result
   strRange = Left(LCase(Trim(strRange)), intChars) 
   
   strNewName = strFolder & "\" & strRange & "." & strExt
   
   objDoc.Close
   Wscript.Sleep 3000
   objFSO.MoveFile strFile.Path, strNewName
  End If
 'End If
Next
 
objWord.Quit

'END

NOTE:
** If you want this to be automated then use Windows Task Scheduler.