Replace multiple spaces with single space using RegExp..

str="Removing      multiple    (multiple     spaces here    )    spaces      with    single (single space here) space   character."&_
"       m done  !   !       &"
Call replaceMultiSpace(str)
Function replaceMultiSpace(strIO)
    replaceMultiSpace=""
    If strIO="" Then
        MsgBox "Invalid input string.."
        Exit Function
    End If
    Set rg=New RegExp
    rg.Global=True
    rg.IgnoreCase= True
    rg.Pattern= "\s{2,}"
     output=rg.Replace(strIO, " ")
     If output<>"" Then     
        replaceMultiSpace=output
         MsgBox "Refined Output: "& replaceMultiSpace
     End If    
     Set rg=Nothing
 End Function

Returns text from a file that starts with certain text..

' This is used to retrive the lines that start with with "Function"..

Dim fso
Dim rline, wline
Dim spath1, spath2
spath1="C:\Users\venu\Desktop\filesrea\Func7up.txt"
spath2="C:\Users\venu\Desktop\filesrea\func7up_func names.txt"
str3="Function"


Set fso = CreateObject("Scripting.FileSystemObject")
Set file1=fso.OpenTextFile(spath1, 1, false)
Set file2=fso.OpenTextFile(spath2, 8, true)
file2.Write ""
Do while file1.AtEndOfStream<>true
    str1= file1.ReadLine
    If str1<>"" Then
        intfound= Instr(1, str1, str3, 1)
        If intfound=1 Then
            file2.WriteLine(str1)
        End If
    End If
Loop

file1.Close
file2.Close
Set fso=Nothing
msgbox "Finally implemented"

Delete duplicate files from a folder

''filna="F:\Songs"

filna=InputBox("Enter required folder path." & vbNewLine & "* Folder path to delete dulicate files from desired folder path."& vbNewLine & "ex: C:\songsFolder")
Call DeleteDupFiles(filna)
Function DeleteDupFiles(strFilePath)
   Set objfs=CreateObject("Scripting.FileSystemObject")
    set sfol= objfs.GetFolder(strFilePath)
    Set sfil=sfol.Files
    i=0
    For each el in sfil

        If instr (1, el.Name, "copy", 1)>0 Then
            i=i+1
            el.Delete
        End If
    Next
    msgbox "Total Duplicate Copies deleted: "& i
End Function

Reminder in my style.

RemDone= False
Set obj= CreateObject("WScript.Shell")
Do While Not RemDone    
    If UCase(MonthName(Month(Date), True))="JUL" And Day(Date)=20 And (Hour(Time)>=10 Or Hour(Time)<=16) Then
        MsgBox "Remind Mr. Ravi about your Sodexo Coupens for the month of Aug..",1,"Reminder about Sodexo Coupens!!"
        MsgBox "Remove the Script file from Start-up folder..", 6, "Warning!!"
        RemDone=True
        Set obj= Nothing
        Exit Do
    Else
        WScript.Sleep 360000        
    End If
Loop

Click on String using getTextLocation method - QTP

set objRef= Browser("MSN.com").Page("MSN.com")
objRef.highlight
ClickString="ENTERTAINMENT"
Call ClickonString(objRef, ClickString)
Function ClickonString(objRef, ClickString)
   ClickonString= False
    If IsObject(objRef) Then
'        objRef.Highlight
        wait 1
        intHwnd=objRef.getROProperty("hwnd")  '' get the window handler of the browser page..
        intL = -1
        intT =  -1
        intR =  -1
        intB =  -1
        On error resume next
        blnCaptureText= TextUtil.getTextLocation(ClickString, intHwnd, intL, intT, intR, intB)
        If blnCaptureText=True Then
             x = (intL + intR)/2
             y = (intT + intB)/2
             wait 1
             Window("hwnd:="& intHwnd).highlight
            
             Window("hwnd:="& intHwnd).Click x , y
            ClickonString= True
        End If
    End if
End Function


Working eg..

extract file extension using vbs 'GetExtensionName' method..

pat="C:\Documents and Settings\vgopi\Desktop\Perso\"
Set fs = CreateObject("Scripting.FileSystemObject") 
Set fold= fs.GetFolder(pat)
Set fil=fold.Files
For Each f In fil
    if fs.GetExtensionName(f.Path)="txt" Then    
        MsgBox     "File Name: '"& f.Name & "' and its extension:- "& fs.GetExtensionName(f.Path) 
    End If
    
NExt
Set fs = Nothing

VBS Prog to delete Folder/Subfolders/All Content

' This script will delete a folder and its content along with subfolders data..
''Note: System defined folders are not deleted.

Set fs=CreateObject("scripting.filesystemobject")
On Error Resume Next
pat=InputBox("Please enter the folder path to delete all the files/subfolders" & vbCrLf & "Eg: C:\Documents and Settings\vgopi\Desktop\ImagesFold", "Enter Folder path here..")

'pat="C:\Documents and Settings\vgopi\Desktop\Perso\New Folder\"
'pat="C:\DOCUME~1\vgopi\LOCALS~1\Temp"    '' "%temp%
'pat= "C:\Documents and Settings\vgopi\Recent"

If pat="" Or IsEmpty(pat) Then
    '' Pat folder path is routed to the following
    pat="C:\Documents and Settings\vgopi\Local Settings\Temporary Internet Files\"
Else
    pat=pat & "\"    '' used to avoid restricted error message..
End If
'MsgBox pat
Set fold= fs.GetFolder(pat)
Set fil=fold.Files
For Each fl In fil
    fl.Delete
Next

Set fld=fold.SubFolders
For Each fd In fld
    Call DeleteSubFolders(fd.path)
    fd.Delete(True)
Next
If fs.FolderExists(pat) Then
    MsgBox "done"
    fold.Delete(True)
End If
Set fs= Nothing
''To delete subfolders and its content..
Function DeleteSubFolders(foldPath)
    Set fso1=CreateObject("Scripting.FileSystemObject")
    Set sfold=fso1.GetFolder(foldPath)
    Call DeleteAllFiles(sfold.Path)
    Set subFold=sfold.SubFolders
'    If subfold.Count<>0 Then
        For Each sbfd In subFold
            Call DeleteSubFolders(sbfd.Path)
            sbfd.Delete(True)            
        Next
'    End If
    Set fso1= Nothing
End Function

Function DeleteAllFiles(Sfiles)    
    Set fso2=CreateObject("Scripting.FileSystemObject")
    Set sfold=fso2.GetFolder(Sfiles)
    Set allFiles=sfold.Files
    For Each fl In allFiles
        fl.Delete(True)
    Next
    Set fso2=Nothing
End Function