Advanced VB Script Examples

'********************************************************************************

Returning multiple values from a Function

'********************************************************************************
Usually Function procedure will return only one value. But by using arrays concept we can return multiple values from a function.


'**********************************************************


Function fnGetOddNumbersInRange(fStartRange,fEndRange)


Dim oddNumbers()    'Declaring Dynamic array to store multiple values


cnt=0            'Initiating a counter to redim the dynamic array


For iCounter=fStartRange to fEndRange


    If iCounter mod 2<>0 Then    'Applying the odd number logic : num/2 <>0 then its an odd number


        ReDim preserve oddNumbers(cnt)
        oddNumbers(cnt)=iCounter        ' Storing Odd numbers in dynamic array
        cnt=cnt+1


    End If
Next


fnGetOddNumbersInRange=oddNumbers        'Assigning array to the function


End Function






'How to work with this function?


oVal=fnGetOddNumbersInRange(1,10)    'Here Function will return array value




For i=0 to ubound(oVal)


    msgbox oVal(i)        ' Displaying the values in array


Next

'********************************************************************************
'Write a program to read data from a text file
'********************************************************************************
'Read Text File
Set fso=CreateObject("scripting.filesystemobject")
Set fl=fso.OpenTextFile(FilePath,1) 'Reading Complete Data from File
 MsgBox fl.ReadAll'********************************************************************************
'Write a program to write data into a text file
'********************************************************************************

Set fso=CreateObject("scripting.filesystemobject")
Set fl=fso.OpenTextFile(FilePath,2)
  'Write characters
 fl.Write("hello")
  'Write blank lines
 fl.WriteBlankLines(2)
  'Write data line by line
 fl.WriteLine("A New Line")'********************************************************************************
'Write a program to print all lines that contains a word either “testing” or “qtp”
'********************************************************************************

Set fso=CreateObject("scripting.filesystemobject")
Set fl=fso.OpenTextFile(FilePath,1) 'Read Data Line by Line
 While Not fl.AtEndOfStream
    If instr(1,fl.ReadLine,"testing")<>0 or instr(1,fl.ReadLine,"qtp")<>0 then
        print fl.ReadLine
    End if
 Wend'********************************************************************************
'Write a program to print the current foldername
'********************************************************************************

Set fso=CreateObject("scripting.filesystemobject")
msgbox fso.GetAbsolutePathName("")'********************************************************************************
'Write a program to print files in a given folder
'********************************************************************************

Dim fso,fld,sFiles,sFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderPath)
Set sFiles = fld.Files
For Each sFile in sFiles
 print sFile.name
Next'********************************************************************************
'Write a program to print subfolders in a given folder
'********************************************************************************

Dim fso,fld,sfolders,sFld
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderPath)
Set sfolders = fld.SubFolders
For Each sFld in sfolders
 msgbox sFld.name
Next'********************************************************************************
'Write a program to print all drives in the file system
'********************************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")
Set drvs = fso.Drives

For Each drv in drvs
  print drv.DriveLetter
Next'********************************************************************************
'Write a program to print current drive name
'********************************************************************************

Set fso = CreateObject("Scripting.FileSystemObject")
msgbox fso.GetDriveName(fso.GetAbsolutePathName(""))'********************************************************************************
'Print the last modified and creation date of a given file
'********************************************************************************

Set fso = CreateObject("Scripting.FileSystemObject")
Set fl = fso.GetFile(FilePath)
print fl.DateLastModified
print fl.DateCreated'********************************************************************************
'Print the size of the file
'********************************************************************************

Set fso = CreateObject("Scripting.FileSystemObject")
Set fl = fso.GetFile(FilePath)
msgbox  fl.Size'********************************************************************************
'Write a program to display files of a specific type
'********************************************************************************
Function DisplaySpecificFileTypes(FolderPath,FileType)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(FolderPath)
    Set sFiles = fld.files
   
    For Each sFl in sFiles
        If lcase(sFl.type)=lcase(FileType) then
            print sFl.name
        End if
    Next

End Function'Calling the Function
DisplaySpecificFileTypes "C:\","Text Document"'********************************************************************************
'Write a program to print the free space in a given drive
'********************************************************************************

Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(drvPath)
print "Free Space: " & FormatNumber(d.FreeSpace/1024, 0) '********************************************************************************
'Write a program to find whether a given folder is a special folder
'********************************************************************************
fldPath="C:\WINDOWS"
Const WindowsFolder =0
Const SystemFolder = 1
Const TemporaryFolder = 2

Set fso = CreateObject("Scripting.FileSystemObject")
If lcase(fso.GetSpecialFolder(WindowsFolder))=lcase(fldPath) or lcase(fso.GetSpecialFolder(SystemFolder))=lcase(fldPath) or lcase(fso.GetSpecialFolder(TemporaryFolder))=lcase(fldPath) then
    print "Given Folder is a special Folder"
Else
    print "Given Folder is not a special Folder"
End if'********************************************************************************
'Write a program to remove all empty files in the folder
'********************************************************************************
FolderPath="C:\Documents and Settings\Sudhindra Immidi\Desktop\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderPath)
Set sFiles = fld.Files
For Each sFile in sFiles

    If sFile.size=0 Then
        print sFile.name
    End If
 
Next'********************************************************************************
'Write a program to Copy contents of one folder to other folder
'********************************************************************************

Function CopyContentstoOtherFolder(SourceFolder,TargetFolder)

Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(SourceFolder)

Set sFiles = fld.Files

For Each sFile in sFiles
  sFile.copy TargetFolder&"\"&sFile.name
Next

Set sFlds = fld.SubFolders

For Each sFld in sFlds
  sFld.copy TargetFolder&"\"&sFld.name
Next

End Function

'Calling the Function
CopyContentstoOtherFolder "C:\Documents and Settings\Sudhindra Immidi\Desktop\Test1","C:\Documents and Settings\Sudhindra Immidi\Desktop\Test2"'********************************************************************************
'Write a program to check whether a given path represents a file or a folder
'********************************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(fPath) then
    Print "Path Representing a File"
Elseif fso.FolderExists(fPath) then
    Print "Path Representing a Folder"
End if'********************************************************************************

'********************************************************************************
'Write a program to compress a folder
'********************************************************************************

strComputer = "."
strFolder   = "Folder Path"

set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set objFolder = objWMI.Get("Win32_Directory='" & strFolder & "'")

fCompress = objFolder.Compress  ' To uncompress change this to objFolder.Uncompress
if fCompress <> 0 then
   WScript.Echo "There was an error compressing the folder: " & fCompress
else
   WScript.Echo "Folder compression successful"
end if'********************************************************************************
'Write a program to rename a folder
'********************************************************************************
CreateObject("Scripting.FileSystemObject").GetFolder("C:\Documents and Settings\sudhi\Desktop\Training Session For MF Testers").Name="New Name"'********************************************************************************
'Write a program to print all lines in a file that ends with “world”
'********************************************************************************

Set fso=CreateObject("Scripting.FileSystemObject")
Set fl=fso.OpenTextFile(FilePath)

Set regEx = New RegExp  'Creating a Regular Expression ObjectregEx.Pattern = "world$"
regEx.Global = True

 While Not fl.AtEndOfStream
    Set Matches = regEx.Execute(strng)

    If Matches.count<>0 then
        print fl.ReadLine
    End if

 Wend'********************************************************************************
'Write a program to check whether string starts with “Error”
'********************************************************************************
str="Errorhello"
Set regEx = New RegExp
regEx.Pattern = "^Error"
regEx.Global = True
Set Matches = regEx.Execute(str)

If Matches.count<>0 then
    msgbox "String Started with 'Error'"
    Else
    msgbox "String Not Started with 'Error'"
End if'********************************************************************************
'Write a program to Replace all words that contains “demo” in a file with the word “QTP”
'********************************************************************************
FilePath="C:\Documents and Settings\sudhi\Desktop\demo.txt"

Set fso=CreateObject("Scripting.FileSystemObject")
Set fl=fso.OpenTextFile(FilePath)
txtToReplace=replace(fl.ReadAll,"demo","QTP")
fl.Close

Set fl=fso.OpenTextFile(FilePath,2)
fl.Write(txtToReplace)
fl.Close'********************************************************************************
'Write a program to check whether a string contains only alpha numerics
'********************************************************************************

str="xyz123!!"
Set regEx = New RegExp
regEx.Pattern = "[^A-Za-z0-9]"
regEx.Global = True
Set Matches = regEx.Execute(str)

If Matches.count=0 then
    msgbox "String Contains only alpha numerics"
    Else
    msgbox "String Contains other characters"
End if'********************************************************************************
'Write a program to check whether given string is in date format
'********************************************************************************
MyDate = "October 19, 1962"

If isdate(MyDate) Then
    msgbox "Given String is in Date Format"
    else
    msgbox "Given String is not in Date Format"
End If'********************************************************************************
'Write a program to Invoke command prompt and execute dir command from the shell
'********************************************************************************
Dim oShell
Set oShell = WScript.CreateObject ("WSCript.shell")
oShell.run "cmd /K CD C:\ & Dir"
Set oShell = Nothing

'********************************************************************************

How to Sort values in an array through creating an Arraylist

'********************************************************************************

AllItems = B(..).P(..).WebList(..).GetRoProperty("all items")
MyArray = Split(AllItems,";")
Set VbArray = DotNetFactory.CreateInstance("System.Collections.ArrayList") ' Creating an objectFor i = 0 To uBound(MyArray)
 VbArray.Add MyArray(i)
Next

'Array before SortingFor i = 0 To VbArray.Count - 1
Print  VbArray.Item(cInt(i))
Next

'Sort Array
VbArray.Sort

'Array after Sorting
For i = 0 To VbArray.Count - 1
Print  VbArray.Item(cInt(i))
Next

'For more about this ArrayList.Click Here

********************************************************************************

Function to compare two arrays,the order of data is not important

'********************************************************************************

Function CompareArraysNotOrder (arrArray1, arrArray2)

   Dim intArray1, intArray2

   For intArray1 = 1 to UBound (arrArray1)
      For intArray2 = 1 to UBound (arrArray2)
         If arrArray1 (intArray1) = arrArray2 (intArray2) Then
             arrArray1 (intArray1) = "Matched":  arrArray2 (intArray2) = "Matched"
             Exit For
         End If
      Next
   Next

   CompareArraysNotOrder = True
   For intArray1 = 1 to UBound (arrArray1)
      If  arrArray1 (intArray1) <> "MATCHED" Then
                 CompareArraysNotOrder = False
                 Exit For
      End If
   Next

End Function

********************************************************************************

Function to save a File through Internet Explorer

'********************************************************************************

Function SaveFileViaInternetExplorer(sEntireFilePath,BrwTitle)

 Brw_Title=BrwTitle

' This is descriptive programming

sTitle="title:=" & Brw_Title & ".*"

' Select 'File menu

Browser(sTitle).WinToolbar("regexpwndclass:=ToolbarWindow32","location:=0").Press "&File"

' Select the the 'Save As' Submenu

Browser(sTitle).WinMenu("menuobjtype:=3").Select "Save As..."

' Enter the Entire path of the file

Browser(sTitle).Window("text:=Save As").WinObject("regexpwndclass:=RichEdit20W").Type(sEntireFilePath)

' Select File Type

Set WshShell = CreateObject("WScript.Shell")

wait(2)

WshShell.SendKeys "{TAB}"

wait(2)

WshShell.SendKeys "{UP}"

WshShell.SendKeys "{UP}"

Window("text:=Save As").WinObject("regexpwndclass:=RichEdit20W").Type(micReturn)

wait(2)

' Select 'File menu

Browser(sTitle).WinToolbar("regexpwndclass:=ToolbarWindow32","location:=0").Press "&File"

' Select the the 'Close' Submenu

Browser(sTitle).WinMenu("menuobjtype:=3").Select "Close"

wait(2)

 End Function

'********************************************************************************
'Write a program to see the format of a date in this format : DD-MMM-YYYY HR:MIN AM/PM QQQ      - (QQQ is any standard time like IST,EDT)

'********************************************************************************

Date Format : DD-MMM-YYYY HR:MIN AM/PM QQQ      - (QQQ is any standard time like IST,EDT)

Sample Test Date : 12-May-2011 08:07 AM EDT

strdata = "12-May-2011 08:07 AM EDT"

Set RegEX = New RegExp  
RegEx.Pattern = "^(([0-9])|([0-2][0-9])|([3][0-1]))\-(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\-\d{4}\s(\d{2}):(\d{2})\s{1}([AP]M)\s[a-z][a-z][a-z]$"
RegEx.IgnoreCase = True

If RegEx.Test(strdata) Then
     Print "Success: String Format matches"
Else
     Print "Fail: String Format doesn't match with the format"
End If

'****************************************************************************************************

'Change the Date format using DotNetFactory . Date format can be changed to desired format

'****************************************************************************************************

Set CultureInfo = DotNetFactory.CreateInstance("System.Globalization.CultureInfo", "System", "en-us")

MsgBox DotNetFactory.CreateInstance("System.DateTime").Parse("5/11/2011", CultureInfo).ToString("dd/MMM/yyyy")

 

'****************************************************************************************************

Sorted Collection list : This list values will be auto sorted as and when items are added to it.

'****************************************************************************************************

        Set objSortedList = CreateObject( "System.Collections.Sortedlist" )

        objSortedList.Add "zello", "1"

        objSortedList.Add "aest", "2"

        objSortedList.Add "sorld", "3"

        objSortedList.Add "fdd", "4"

        For i = 0 To objSortedList.Count - 1

             MsgBox objSortedList.GetKey(i) & vbTab & objSortedList.GetByIndex(i)

        Next 

        MsgBox "Size     : " & objSortedList.Count

        MsgBox "Capacity : " & objSortedList.Capacity

        objSortedList.TrimToSize

        MsgBox "Size     : " & objSortedList.Count

        MsgBox "Capacity : " & objSortedList.Capacity

        'This will result in the following output:

        'Size     : 4

        'Capacity : 16

        'Size     : 4

        'Capacity : 4

         'Cloning a SortedList is a piece of cake:

        Set objList2 = objSortedList.Clone

        MsgBox "Sorted List Key(1) = " & objSortedList.GetKey(1)

        MsgBox "Cloned List Key(1) = " & objList2.GetKey(1)

 

'****************************************************************************************************

Reading PDF from Adobe Reader : Printing PDF File

'****************************************************************************************************

        'Required Abode Reader to install on the machine
        Set objAcroPDF = CreateObject("AcroPDF.PDF")

        'Through this object there are very few methods like print etc.

        objAcroPDF.LoadFile("C:\Sudhi\PDF_test.pdf")
        objAcroPDF.PrintAll
        Set objAcroPDF = Nothing

'****************************************************************************************************

Reading PDF from Adobe Reader : Printing PDF File

'****************************************************************************************************

        'Required Abode Reader to install on the machine
        Set objAcroPDF = CreateObject("AcroPDF.PDF")

        'Through this object there are very few methods like print etc.

        objAcroPDF.LoadFile("C:\Sudhi\PDF_test.pdf")
        objAcroPDF.PrintAll
        Set objAcroPDF = Nothing

'****************************************************************************************************

Reading PDF from Adobe Reader : Printing PDF File

'****************************************************************************************************

        'Required Abode Reader to install on the machine
        Set objAcroPDF = CreateObject("AcroPDF.PDF")

        'Through this object there are very few methods like print etc.

        objAcroPDF.LoadFile("C:\Sudhi\PDF_test.pdf")
        objAcroPDF.PrintAll
        Set objAcroPDF = Nothing

'****************************************************************************************************

Make your computer speak through VBS file

'****************************************************************************************************

        Set oSpeak = CreateObject("sapi.spvoice")
        oSpeak.Rate = -2
        oSpeak.Speak "In my world of Testing"

        Set oSpeak=Nothing 


        'Save the above code in txt file and rename the extension with .vbs and execute it 

'****************************************************************************************************

Reading PDF from Adobe Acrobat Reader : Retrieving number of Pages.

'****************************************************************************************************

'Required Abode Acrobat Reader to install on the machine

Set oPDFDoc = CreateObject( "AcroExch.PDDoc")

If oPDFDoc.Open( PDFFileName ) Then

    GetNumPagesInPDF = oPDFDoc.GetNumPages()

Else

    GetNumPagesInPDF = 0

End If

Print GetNumPagesInPDF

Set oPDFDoc = Nothing

  

'Set objAVDoc = CreateObject("AcroExch.AVDoc")--we have to create one avdoc object per displayed document.

'Set PdfForm = CreateObject("AFormAut.App")--to manipulate from pdf forms

'Set objAcrApp = CreateObject("AcroExch.App")--creating acrobat application object

'****************************************************************************************************

How to lock system after executing scritps

'****************************************************************************************************

           Set obj = CreateObject(“WScript.Shell”)
           sCmnd = "%windir%\SYSTEM32\rundll32.exe user32.dll,LockWorkStation"
           obj.Run sCmnd, 0, False
           Set obj =nothing