'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0
'
' NAME: Character_replacement_with_file_extesion_filter.vbs
'
' AUTHOR: MaNCiS , Syamster
'
' DATE : 9/29/2006
'
' COMMENT: Tukar character / words dalam sesuatu file (*.txt, *.doc, *.htm etc)
'
'==========================================================================
Dim FSO, sFolder, sDestination, strCharFilter, strCharGanti
' Insert -- SOURCE FOLDER --
sFolder = "X:\Project\find_and_replace1\"
' Insert -- DESTINATION FOLDER --
sDestination = "X:\Project\find_and_replace2\"
' Insert -- CHARACTER/WORDS TO SEARCH --
strCharFilter = "%"
' Insert -- NEW CHARACTER/WORDS TO REPLACE --
strCharGanti = " percent"
fileExt = ".txt" ' Insert -- FILE EXTENSION --
Const ForReading = 1
Const ForWriting = 2
Set FSO = CreateObject("Scripting.FileSystemObject")
Set inputPath = FSO.GetFolder(sFolder)
For Each namaFile In inputPath.Files
'MsgBox namaFile ' Check file found in input folder
' Use to process only filtered file type(count 4 character from right to left)
If lcase(Right(namaFile,4)) = fileExt Then
Set openFile = FSO.OpenTextFile(namaFile, ForReading)
strText = openFile.ReadAll 'Read through file
'MsgBox strText
openFile.Close
strNewText = Replace(strText, strCharFilter, strCharGanti)
Set openFile = FSO.OpenTextFile(namaFile, ForWriting)
'Replace defined CHARACTER/WORD declare earlier
openFile.WriteLine strNewText
openFile.Close
'MsgBox FSO.OpenTextFile(namaFile,ForReading).ReadAll
FSO.OpenTextFile(namaFile,ForReading).Close
' Copy file found in input folder to output folder
FSO.CopyFile namaFile, sDestination
' Delete original file in inputfolder
FSO.DeleteFile namaFile
Else
'MsgBox namaFile & " not being process." ' For error trapping
End If
Next
'MsgBox "Done" 'Process done
' Clearing all value to nothing/Null
sFolder = ""
sDestination = ""
strCharFilter = ""
strCharGanti = ""
fileExt = ""
strText = ""
strNewText = ""
openFile = ""
namaFile = ""
P/s: Harap bule la membantu org lain sama...
No comments:
Post a Comment