Monday, August 29, 2011

Find-Replace value in Excel: VB Script

'*********************************************************
'Author : MindLess
'version 4
'Language: VB Script
'Date 01 -Apr- 2011
'Purpose: For changing the data of Excel datasheet inside a folder.
'Just double click
'Dont Change the file name.
'You can change this script as per your requirement.


'**********************************************************
'**********************************************************
 'Main Function CallSub Inputval()
'**********************************************************
v_folderpath = Trim(inputbox("Input the folder path ", "Path..."))
v_folderpath = blankCheck(v_folderpath, "Input the folder path" )
if v_folderpath ="No" Or v_folderpath = "" Then
 Exit Sub
End If


v_no= Trim(inputbox("Input no of different data you want to change", "No of data.."))
v_no= blankCheck(v_no, "Input no of different data you want to change")
if v_no ="No" Or  v_no = "" Then
 Exit Sub
End If
'Option Explicit
Dim v_oldv()
Dim v_newv()
Redim v_oldv(v_no)
Redim v_newv(v_no)
for i= 0 to v_no - 1
v_oldv(i) = Trim(inputbox("Input the Old value", "Find..."))
if v_oldv(i) ="No" Or  v_oldv(i) = "" Then
 Exit Sub
End If
'If v_oldv <> "" then
v_newv(i) = Trim(inputbox("Input The New value for " & v_oldv(i), "Replace..")) 
v_temp = v_newv(i)
v_newv(i) = blankCheck(v_temp,"Input The New value for " & v_oldv(i))
if v_newv(i) ="No" or v_newv(i) = "" Then
 Exit Sub
End If

'End if
Next
FindReplace v_oldv, v_newv, v_folderpath, v_no
Msgbox "Done"
End Sub
'*************************************************************************
Sub FindReplace(v_old, v_new, v_path, v_no)
dim objFS, oFolder
set objFS = WScript.CreateObject("Scripting.FileSystemObject")
set objFolder = objFS.GetFolder(v_Path)
Set Fillist = objFolder.Files
'msgbox objFolder.Files.Count
Set objExcel = CreateObject("Excel.Application")
 objExcel.DisplayAlerts = False
For each fil in Fillist
 If fil.name <> "Find_Replace.vbs" Then
        'msgbox fil.name
  v_compltfilename = V_Path & "\" & fil.name
 'msgbox v_compltfilename
 'Open the workbook

 Set objWorkBook = objExcel.Workbooks.Open(v_compltfilename)
 'Set up a reference to the sheet in the workbook
 Set objWorkSheet = objWorkBook.WorkSheets(1)
 Set objRange = objWorkSheet.Range("B1")
 objRange.Select
 For i= 0 to v_no-1
 objRange.Replace v_old(i), v_new(i)
 Next
 objWorkBook.Save
 objWorkBook.Close
 End If
  next
objExcel.Quit
Set objWorkBook = Nothing
objExcel.DisplayAlerts = True
Set objExcel = Nothing

End Sub
'********************************************************
 Public Function blankCheck(v_val, msg)
If v_val = "" then
  v_msgret = Msgbox("Your value is blank. Press Retry to re enter!",5, "Alert!!! Blank value..")
 If v_msgret = 4 then
  v_new = Trim(inputbox(msg, "Retry"))
  blankCheck = v_new
 Else
  blankCheck = "No"
  Exit Function
 End If
Else
 blankCheck = v_val
End if
End Function
Public Sub closeDialog(v_val)
if v_val = "" Then
Exit Sub
End If
End Sub
'********************************** Closure**************
Set objShell = Nothing
Set objFS = Nothing
Set objFolder = Nothing
Set Fillist = nothing
'objWorkBook.Save
'objWorkBook.Close 

No comments:

Post a Comment

Feel free to write..