Robo Fusion: Vara veena mrudu paani song on piano with selenium automation. Selenium Code

When you cannot cover it manually, AUTOMATE it !
Love carnatic music. Love automation.
Robo Fusion: Vara veena mrudu paani song on piano with selenium automation.
వరవీణా మృదుపాణీ, వనరుహలోచన రాణీ..
#piano #Selenium #automation #varaveena #carnaticmusic

Main script:

package playPiano;

import org.openqa.selenium.WebDriver;

public class playPianoDriver {

public static void main(String[] args) throws Exception {

//Array (Octave:0/1/2/3/4)(note)(timeunit)

String sng[]= {"1e","1e","1g2","1g2","1a","1g","2c2","2c2","2d","2c","1a","1a","1g2","1a","1g","1e","1e","1d2","1e","1g","1a","2c","1a2","1a","1g","1e","1e","1d2","1e","1e","1a","1g","1e2","1g","1e","1e","1d","1c2","1e","1e","1e","1e","1d","1e","1g","1e","1g2","1g2","1e","1e","1a","1g","1a2","1a","1g","2c2","2c2","1a","2e","2d","2d","2c","2c","1a","2c","1a","1a","1a","1g","1e","1g","1a","2c","1a","1g","1a","1g","1e","1e","1d","1c","1c","1e","1e2","1e2","1e","1d","1g","1e","1d2","1c","1d","1c","1e","1d","1c","1d","1d","1c2","1c2"};

WebDriver drv=playPianoFuncs.launchApplication(keyConstants.url);

 

playPianoFuncs.playPiano(drv, sng);

 

}

}

Function library:

package playPiano;

import java.util.concurrent.TimeUnit;

import org.openqa.selenium.By;

import org.openqa.selenium.WebDriver;

import org.openqa.selenium.WebElement;

import org.openqa.selenium.chrome.ChromeDriver;

public class playPianoFuncs {

//launch application

public static WebDriver launchApplication(String url)

{

WebDriver drv=null;

 

System.setProperty("webdriver.chrome.driver", keyConstants.chromeDriverPath);

 

// Initialize browser

drv=new ChromeDriver();

// Open url

drv.get(url);

drv.manage().timeouts().implicitlyWait(keyConstants.commonTimeOut,TimeUnit.SECONDS);

// Maximize browser

drv.manage().window().maximize();

drv.manage().timeouts().implicitlyWait(keyConstants.commonTimeOut, TimeUnit.SECONDS);

return drv;

}

//get key numbers

public static int getKeyNumbers(int octave,String Keyname)

{

int keyNum=0;

switch (Keyname) 

{

//White keys

case "c": keyNum=keyConstants.c[octave];break;

case "d": keyNum=keyConstants.d[octave];break;

case "e": keyNum=keyConstants.e[octave];break;

case "f": keyNum=keyConstants.f[octave];break;

case "g": keyNum=keyConstants.g[octave];break;

case "a": keyNum=keyConstants.a[octave];break;

case "b": keyNum=keyConstants.b[octave];break;

//Black keys

case "C":

case "db": keyNum=keyConstants.db[octave];break;

case "eb": keyNum=keyConstants.eb[octave];break;

case "gb": keyNum=keyConstants.gb[octave];break;

case "ab": keyNum=keyConstants.ab[octave];break;

case "bb": keyNum=keyConstants.bb[octave];break;

}

return keyNum;

}

//play piano

public static void playPiano(WebDriver drv,String[] sng) throws InterruptedException

{

for (String string : sng) 

{

int octave=Integer.parseInt(string.substring(0, 1));

string=string.substring(1);

int playTime=keyConstants.kaalam1;

if(string.length()==2) {playTime=keyConstants.kaalam2;string=string.substring(0, 1);}

//System.out.println(string);

int ky=playPianoFuncs.getKeyNumbers(octave,string);

//System.out.println("Key number:"+ky);

WebElement key=drv.findElement(By.cssSelector("*["+keyConstants.keyboardAttribute+"='"+ky+"']"));

key.click();

TimeUnit.MILLISECONDS.sleep(playTime);

}

}

}

Constants File:

package playPiano;

public class keyConstants {

//Octave (Low-0, Medium-1, High-2)

//public static int LMH=1;

//Tempo

public static int kaalam1=500;

public static int kaalam2=1000;

//Low,Mid,High - White Keys

public static int c[]= {90,84,221};

public static int d[]= {88,89,86};

public static int e[]= {67,85,66};

public static int f[]= {81,73,78};

public static int g[]= {87,79,77};

public static int a[]= {69,80,188};

public static int b[]= {82,219,190};

//Low,Mid,High - Black Keys

public static int db[]= {83,54,70};

public static int eb[]= {68,55,71};

public static int gb[]= {50,57,74};

public static int ab[]= {51,48,75};

public static int bb[]= {52,187,76};

//driver and browser settings

public static String chromeDriverPath="C:\\AEM Migration Project\\Eclipse\\chromedriver.exe";

public static String url="https://www.musicca.com/piano";

//time parameters

public static int commonTimeOut=120;

public static int httpConnTimeOut=120000;

//Piano specific attribute

public static String keyboardAttribute="data-key";

}

Bribing problem - Java code

Problem

Solution

Socks problem - Can you help me with better logic ?

Problem:

Solution:

static int sockMerchant(int n, int[] ar) {

        int cnt=0;

        Arrays.sort(ar);

        for(int i=0;i<n-1;i++)

            if(ar[i]==ar[i+1]){cnt++;i++;}

        return cnt;

    }

Counting Valleys - Can you find a better solution? (Code in Java)

Problem:

Java8 Code:

static int countingValleys(int n, String s) {

        int lvl=0,vc=0;

        boolean valleyFlag=false;

        char[] stps=s.toCharArray();

        

        for(int i=0;i<stps.length;i++)

        {

            if(stps[i]=='D') lvl--;

            else if(stps[i]=='U') lvl++;

            if(lvl==0 && valleyFlag==true)

            {

                valleyFlag=false;

                vc++;

            }

            if(lvl==-1) valleyFlag=true;

        }

        return vc;

    }

VBA to replace text in word document (from a template)

Sub createProposal()
   
    propFolder = "C:\AA-ProjectsDocs\AA_Proposal Templates\"
    commPropFileName = "TetraSoft_CLIENTNAME_CommercialProposal_PROJECTNAME_SA.docx"
   
    clientNam = Sheet1.Cells(3, 3)
    projNam = Sheet1.Cells(4, 3)
   
    destFileName = propFolder & "TetraSoft_" & clientNam & "_CommercialProposal_" & projNam & ".docx"
   
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.CopyFile(propFolder & commPropFileName, destFileName, True)
    Set FSO = Nothing
   
    Set wordapp = CreateObject("word.Application")
    wordapp.Documents.Open destFileName
    'wordapp.Visible = True
    'wordapp.Activate
   
    For rw = 3 To Sheet1.UsedRange.Rows.Count
       
        findWord = "<" & Sheet1.Cells(rw, 2) & ">"
        replaceWith = Sheet1.Cells(rw, 3)
        wordapp.Selection.Find.ClearFormatting
        wordapp.Selection.Find.Replacement.ClearFormatting
        wordapp.Selection.WholeStory
        With wordapp.Selection.Find
            .Text = findWord
            .Replacement.Text = replaceWith
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=2
        End With
       
    Next
    wordapp.Documents.Save
    wordapp.Visible = True
   
    'wordapp.Documents.Close
    'wordapp.Quit
    'Set wordapp = Nothing
End Sub

Disable copy paste code in blog - using javascript

If you are looking for code that disables copy paste on your blog, this is it.
Add a new html/javascript gadget and keyin below code.

< script src = 'demo-to-prevent-copy-paste-on-blogger_files/googleapis.js' > < /script><script type='text/javascript'>

if(typeof document.onselectstart!="undefined" )

{

document.onselectstart=new Function ("return false" );

}

else

{

document.onmousedown=new Function ("return false" );

document.onmouseup=new Function ("return false");

}

</script>

Disable right click in your website using javascript

If you are looking for code that disables right click on your blog, this is it.

Add a new html/javascript gadget and key in below code.

< script language = javascript > <!-- var message = "Function Disabled"; function clickIE() { if (document.all) { (message); return false; } } function clickNS(e) { if (document.layers || (document.getElementById && !document.all)) { if (e.which == 2 || e.which == 3) { (message); return false; } } } if (document.layers) { document.captureEvents(Event.MOUSEDOWN); document.onmousedown = clickNS; } else { document.onmouseup = clickNS; document.oncontextmenu = clickIE; } document.oncontextmenu = new Function("return false")//-->
</script>

RPA UIPATH: Use delay and check outlook mail every 5 minutes/required interval

Requirement: Delay the UIPath execution
Solution: TimeSpan.FromMinutes(5) -- delays 5 minutes
                Similarly you can delay for days, hours, minutes, seconds, milli seconds

*------------------THE END(IF YOU ARE LOOKING JUST FOR ABOVE INFORMATION)--------------------*

Below is the image/setup for read outlook mail inbox every 5 minutes and display subject

HOW TO SET OUTLOOK MESSAGE FILTER IN UIPATH / FILTER MESSAGE BY DATE

Requirement: Display all mails received today
Solution:  "[Received]>'" & now.ToShortDateString & "'"


*------------------THE END(IF YOU ARE LOOKING JUST FOR ABOVE INFORMATION)--------------------*


I am sure if you are searching for filters you know how to read messages from outlook,
however for new learners providing steps below.

1. Drag drop "Sequence"
2. Drag "Getoutlook mail messages" into sequence, set it up as per requirement1 or 2 shown below
3. Drag for each and provide any variable before "in" and output variable in step 2 setup and change it to mail message type in properties as shown in below image
4. YOU ARE DONE!!  Inside the body of for each, add code whatever you want !!

Reference:

Requirement1: Display all mails received today
Solution:  "[Received]>'" & now.ToShortDateString & "'"

Requirement2: Display all mails received today and has excel attachment
Solution:  "[Received]>'" & now.ToShortDateString & "' and [attachment]='*.xls*'"

For more outlook filters check: https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/cc513841(v=office.12)?redirectedfrom=MSDN

VBA code to update test in ALM Test Plan

You might have come across situations where you need to bulk update test cases data, below is the coded for doing same based on test name, you can do same based on test id too. I have mentioned the test id parameter in code too in case you want to try id based updates.

Sub UpdateTestPlan()

'=========================================
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "http://<XXXX>.us.<XXXX>.com/qcbin"
qcID = Sheet1.Cells(2, 1)
qcPWD = Sheet1.Cells(2, 2)
tdc.Login qcID, qcPWD
tdc.Connect "<XXXX>", "<XXXX>"
'=========================================

On Error GoTo err

uR = Sheet2.UsedRange.Rows.Count
Set TestList = tdc.TestFactory
Set TestPlanFilter = TestList.Filter
k = 2
For eR = 2 To uR
    k = eR
    testPlanID = Sheet2.Cells(eR, 2)
    If IsEmpty(testPlanID) Then
    Else
        TestPlanFilter.Filter("TS_TEST_ID") = testPlanID
        Set TestPlanList = TestList.NewList(TestPlanFilter.Text)
        Set myTestPlan = TestPlanList.Item(1)
        MsgBox myTestPlan.Field("TS_STATUS")
        MsgBox myTestPlan.Field("TS_NAME")
        MsgBox myTestPlan.Field("TS_SUBJECT")
        myTestPlan.Field("TS_STATUS") = Sheet2.Cells(eR, 3)
        myTestPlan.Post
        Sheet2.Cells(eR, 1) = "Successfull"
    End If
Next
'Set TestPlanFilter = Nothing
'Set myTestPlan = Nothing
'Set TestList = Nothing
'Set TestPlanFilter = Nothing
err:
    tdc.Disconnect
    tdc.Logout
    tdc.ReleaseConnection
    Application.StatusBar = err.Description
    Sheet2.Cells(k, 1) = err.Description
    ActiveWorkbook.Save
End Sub

VBA Code to update test sets in ALM testlab

Hi All,
You might have come across scenarios where you are required to pass/fail many test cases in a test set. As ALM does not support bulk update, the easy way is to write a macro that does the job.Below is code for the same.

Sub ConnectToQualityCenter()
    Application.StatusBar = "Initiating connection"
    Dim qcURL As String
    Dim qcID As String
    Dim qcPWD As String
    Dim qcDomain As String
    Dim qcProject As String
    Dim tdConnection As Object
    Dim TestSetFact, tsTreeMgr, tSetFolder, TestSetsList, theTestSet
    Dim TestSetIdentifier, TSTestFact, TestSetTestsList, testInstanceF, aFilter
    Dim lst, tstInstance

    On Error GoTo err
    qcURL = "http://<XXXXX>.us.<XXXXX>.com/qcbin"
    qcID = Sheet1.Cells(2, 1)
    qcPWD = Sheet1.Cells(2, 2)
    If IsEmpty(qcID) Or IsEmpty(qcPWD) Then
        Application.StatusBar = "UID/PWD fields are mandatory"
        GoTo err2
    End If
    qcDomain = "<XXXXX>"
    qcProject = "<XXXXX>"

    'Display a message in Status bar
     Application.StatusBar = "Connecting to ALM..."
    'Create a Connection object to connect to Quality Center
      Set tdConnection = CreateObject("TDApiOle80.TDConnection")
    'Initialise the Quality center connection
       tdConnection.InitConnectionEx qcURL
    'Authenticating with username and password
       tdConnection.Login qcID, qcPWD
       Application.StatusBar = "Login successfull"
    'connecting to the domain and project
       tdConnection.Connect qcDomain, qcProject
    'On successfull login display message in Status bar
      Application.StatusBar = "Connection Established to <XXXXX>/<XXXXX>"


    '---------------------------------------Connection Established --------------------------------------------------------------------------
    ' Get the test set tree manager from the test set factory
    'tdconnection is the global TDConnection object.
    Set TSetFact = tdConnection.TestSetFactory
    Set tsTreeMgr = tdConnection.testsettreemanager
    ' Get the test set folder passed as an argument to the example code
    npath = Sheet1.Cells(2, 4)
    testSetName = Split(npath, "\")(UBound(Split(npath, "\")))
    npath = Replace(npath, testSetName, "")

    Set tsFolder = tsTreeMgr.NodeByPath(npath)
    '--------------------------------Check if the Path Exists or NOt ---------------------------------------------------------------------
    If tsFolder Is Nothing Then
        Application.StatusBar = "Invalid test set path"
    End If

    ' Search for the test set passed as an argument to the example code
    Set tsList = tsFolder.FindTestSets(testSetName)
    '----------------------------------Check if the Test Set Exists --------------------------------------------------------------------
    If tsList Is Nothing Then
        Application.StatusBar = "Invalid test set name"
    End If

    '---------------------------------------------Check if the TestSetExists or is Duplicated ----------------------------------------------
    If tsList.Count > 1 Then
        Application.StatusBar = "Found more than one test set:-> refine search"
        Exit Sub
    ElseIf tsList.Count < 1 Then
        Application.StatusBar = "Test set not found"
        Exit Sub
    End If

    '-------------------------------------------Access the Test Cases inside the Test SEt -------------------------------------------------

    allScriptsNames = ""
    usedrowsCounter = Sheet1.UsedRange.Rows.Count
    For rI = 2 To usedrowsCounter
        If IsEmpty(Sheet1.Cells(rI, 5)) Or IsEmpty(Sheet1.Cells(rI, 6)) Or InStr(1, allScriptsNames, Sheet1.Cells(rI, 5)) > 1 Then
        Else
            allScriptsNames = allScriptsNames & "##" & Sheet1.Cells(rI, 5) & "##" & Sheet1.Cells(rI, 6)
        End If
    Next

    Set theTestSet = tsList.Item(1)
    For Each testsetfound In tsList
        Set tsFolder = testsetfound.TestSetFolder
        Set tsTestFactory = testsetfound.tsTestFactory
        Set tsTestList = tsTestFactory.NewList("")
   
        For Each tsTest In tsTestList
            Application.StatusBar = tsTest.Name & tsTest.TestId
            testrunname = Sheet1.Cells(2, 3)
            If InStr(1, allScriptsNames, tsTest.Name + "##") > 1 Then
                'MsgBox Split(Split(allScriptsNames, tsTest.Name + "##")(1), "##")(0)
                '--------------------------------------------Accesss the Run Factory --------------------------------------------------------------------
                Set RunFactory = tsTest.RunFactory
                Set obj_theRun = RunFactory.AddItem(CStr(testrunname))
                obj_theRun.Status = Split(Split(allScriptsNames, tsTest.Name + "##")(1), "##")(0)
                obj_theRun.Post
            End If
        Next tsTest
    Next testsetfound

err:

    tdConnection.Disconnect
    tdConnection.Logout
    tdConnection.ReleaseConnection
    Application.StatusBar = "Logged Out"
err2:
    If (err.Number <> 0) Then
        'Display the error message in Status bar
        Application.StatusBar = err.Description
    End If
End Sub

Function TimeStamp()
  Dim CurrTime
  CurrTime = Now()

  TimeStamp = CStr(Year(CurrTime)) & "-" _
    & LZ(Month(CurrTime)) & "-" _
    & LZ(Day(CurrTime)) & " " _
    & LZ(Hour(CurrTime)) & ":" _
    & LZ(Minute(CurrTime)) & ":" _
    & LZ(Second(CurrTime))
End Function

Framework to learn any Automated Tool

Object Identification

Library files

Sample Functions

Parametarization/data table operations

Running sample Automated tests and debugging

Enhancing the tests and adding loops and error handling etc.

synchronizing options

Batch Test Execution

Advanced:

how to handle third party controls and object identification issues

How to recover if the applications crashes or any unexpected behavior(automation tool or application) occurs

DOM and COM objects support 

Find the number of groups of 1s in a MATRIX

Problem: Given a matrix with 1s and 0s, please find the number of groups of 1s. A group is defined by horizontally or vertically adjacent 1s. For example, there are four groups of 1s in Figure below which are drawn with different colors.

Solution:

import java.util.HashMap;

public class matrixGroups
{

  static int[][] tab={{1,1,0,0,0}, {1,0,1,1,0}, {1,0,1,0,1}, {1,1,1,0,1}};

  static int elementInGroup=1;
  static HashMap<String,Integer> grps=new HashMap<String,Integer>();
  static int groupsCount=0;
  public static void main(String[] args)
  {
      
   System.out.println(tab[0].length+"-"+tab.length);
   for(int iRow=0;iRow<tab.length;iRow++)
 {
   for(int iCol=0;iCol<tab[0].length;iCol++)
  {
  if((tab[iRow][iCol]==elementInGroup))
  {
    System.out.println(iRow+"-"+iCol);
    getAdjacentOnes(iRow,iCol);
  }
  }
 }
 System.out.print(groupsCount+" Groups: "+grps.toString());
  }

  //find if new group

  static void getAdjacentOnes(int r,int c)
  {
    String current=r+"x"+c;
    String top=(r-1)+"x"+c;
    String left=r+"x"+(c-1);
 if(r>0)//not first in rows
      if(tab[r-1][c]==elementInGroup)
        if(grps.containsKey(top))//group already created
         grps.put(current,grps.get(top));
        else //create new group
        {
          groupsCount++;
          grps.put(top,groupsCount);
          grps.put(current,groupsCount);
        }
 if(c>0)//not first in columns
      if(tab[r][c-1]==elementInGroup)
        if(grps.containsKey(left))//group already created
        grps.put(current,grps.get(left));
        else //create new group
        {
          groupsCount++;
          grps.put(left,groupsCount);
          grps.put(current,groupsCount);
        }
  }
}

QC OTA || Add/Upload a bussiness component into qc

'Code to add/upload business component into QC
'Note:to use this code Extended Storage Object has to be enabled in site Admin
 sub add_comp()
 qcUser = ""
    qcPassword = ""
    Domain = ""
    Project = ""
   
    qcServer = "http://qcHostName:qcPort/qcbin"

    Set tdc = CreateObject("TDApiOle80.TDConnection")
    tdc.InitConnectionEx qcServer
    tdc.Login qcUser, qcPassword
    tdc.Connect Domain, Project
     Set objCompFldrFact = tdc.ComponentFolderFactory
    Set rootCompFldr = objCompFldrFact.Root
    Set compFactory = rootCompFldr.ComponentFactory
    ' Add the component
    compName = "Test_comp"
     Set myComp = compFactory.AddItem(Null)
    Dim errString As String
    If (compFactory.IsComponentNameValid(compName, errString)) Then
        myComp.Name = compName
       ' myComp.ExtendedStorage (0)
         myComp.ScriptType = "QT-SCRIPTED"
        myComp.ApplicationAreaID = 897
        myComp.Post
        Set extStor = myComp.ExtendedStorage(0)
        extStor.ClientPath = "C:\Backup\ECC\Login"
         extStor.Save "-r *.*", True
    Else
        myComp.Name = "DefaultValidName"
        MsgBox errString
    End If
    'Loads all the files from the directory
    myComp.Post
 'addding parameters to the added component
    Set compParamFactory = myComp.ComponentParamFactory
    Set compParam1 = compParamFactory.AddItem(Null)
    compParam1.IsOut = 0    'false
    compParam1.Name = compName
    compParam1.desc = "Description for test parameter"
    compParam1.ValueType = "String"
    compParam1.Order = 1
    compParam1.Post
    Set compParam1 = Nothing
 Set compParamFactory = Nothing
 Set extStor =  Nothing
 Set myComp = Nothing
 Set objCompFldrFact = Nothing
    Set rootCompFldr = Nothing
    Set compFactory = Nothing
 'Disconnect from the project
 If tdc.Connected Then
  tdc.Disconnect
 End If
 ''Log off the server
 If tdc.LoggedIn Then
 tdc.Logout
 End If
 ''Release the TDConnection object
 tdc.ReleaseConnection
 Set tdc = Nothing

end sub

VbScript to call windows API Functions (user32 dll)

We can make use excel object and ExecuteExcel4Macro method to call User32 DLL methods.

Below is the syntax:

CALL(dll_name, function_name, type_string, func_arguments1, ..., func_argumentsN)

dll_name - the name of the DLL, which contains the desired function. This name must contain the full path if the DLL is not located in your Windows, System folder, or the folder specified in the environment variable PATH.
function_name - name of the function.
type_string - text string that identifies the data type of the return value and the data types of all parameters. The first character type_string defines the return value.
func_arguments1, ..., func_argumentsN - function parameters. Their types must comply type_string. It may be transmitted up to 27 parameters.
Data types for type_string:
B - 8-byte floating-point number (IEEE), Transferred by Value, C type double.
C - Zero (null) terminated string (max. Length = 255 characters), Transferred by Reference, C type char *
F - Zero (null) terminated string (max. Length = 255 characters), Transferred by Reference (modify in place), C type char *
J - 4 bytes wide signed integer, Transferred by Value, C type long int
P - Excel's OPER data structure, Transferred by Reference, C type OPER *
R - Excel's XLOPER data structure, Transferred by Reference, C type XLOPER *
Examples:

Dim hwnd

CreateObject("WScript.Shell").Run "notepad", 1, False
With CreateObject("Excel.Application")
 hwnd = .ExecuteExcel4Macro("CALL(""user32"", ""FindWindowA"", ""JCJ"", ""Notepad"", 0)")
 If hwnd = 0 Then
  wscript.echo "note pad window not found"
  WScript.Quit
 Else
  wscript.echo "note pad window found"

  Excel.ExecuteExcel4Macro "CALL(""user32"",""ShowWindow"",""JJJ""," & hwnd & ","& SW_
RESTORE
&")"

 End If
end with

*********************************************************
some other uses:
  GetPIDByHWND = excel.ExecuteExcel4Macro("CALL(""user32"", ""GetWindowThreadProcessId"", ""2JN"", " & CStr(hwnd) & ", 0)")
  hwnd = excel.ExecuteExcel4Macro("CALL(""user32"", ""GetDesktopWindow"", ""J"")")
  hwnd = excel.ExecuteExcel4Macro("CALL(""user32"", ""GetWindow"", ""JJJ"", " & CStr(hwnd) & ", 5)")
' Puts the cursor at the specified X and Y corrdinates
  Excel.ExecuteExcel4Macro("CALL(""user32"",""SetCursorPos"",""JJJ""," & x & "," & y & ")")

Code to kill all the other wscripts running on the system Except current wscript || Vb Script || shell

    'Create windows management object
    Dim objWinMgmts
    Dim process_List
    Set objWinMgmts = GetObject("WinMgmts:Root\Cimv2")
    'Get the list of all the wscripts running in the system
    Set process_List = objWinMgmts.ExecQuery("Select * From Win32_Process where name='wscript.exe'")
    'Get the process id of the current executing wscript ('this' object)
    Dim cpid, cpst
    cpid = 0
    cpst = FormatDateTime("01/01/1900")
    For Each objProcess In process_List
        If objProcess.CreationDate > cpst Then
            cpid = objProcess.ProcessId
            cpst = objProcess.CreationDate
        End If
    Next
    'Except current wscript, kill all the other wscripts running on the system
    For Each objProcess In colProcess
        If cpid <> objProcess.ProcessId Then
            objProcess.Terminate
        End If
    Next
    Set process_List = Nothing
    Set objWinMgmts = Nothing

Create and Delete Windows User-defined Environment Variables +Vb Scrpt/Shell

'# Code to set a System/user environment variable and Variable Value:

strVarName = "varWorkingDir"
strVarValue = "D:\"

Function Create_System_Environment_Variable(strVarName ,strVarValue )
             Dim wshshell
             Set wshshell = CreateObject("WScript.Shell")

             Dim WshSysUserEnv

             Set WshSysUserEnv= wshshell.Environment("User")

             WshSysUserEnv("varAutomation_WorkingDir")= strVarValue

             Set WshSysUserEnv= Nothing

End Function

'# Code to remove/delete the environment variable:

Function Remove_System_Environment_Variable(strVarName)


               Dim wshshell

               Set wshshell = CreateObject("WScript.Shell")

               Dim WshSysUserEnv

               Set WshSysUserEnv= wshshell.Environment("User")

               WshSysUserEnv.Remove(strVarName)

               Set WshSysUserEnv= Nothing

End Function

VB Scirpt || ADODB Connection Code

PUBLIC Records_Count
PUBLIC Ret_Val

DB_ServerConn_String = "HOST=< Server IP addr or name>;PORT=<server prot num>;SERVICE_NAME=<servicename or sid>;uid=<Username>;pwd=<password>"
OR
DB_ServerConn_String = "DSN=<predefinedDSNCOnnectionName>;USERID=<Username>;Password='<password>'"
Click here To find Examples for Connection string

Function Execute_Query(DB_ServerConn_String ,QueryString)
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
'Const adOpenStatic = 3
'Const adLockOptimistic = 1 ''adLockReadOnly
'Const adUseClient = 2 ''adUseServer

Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")

objConnection.Open DB_ServerConn_String
If objConnection.state=1 Then
objConnection.CommandTimeout=0
objRecordset.CursorLocation = adUseClient
objRecordset.Open QueryString , objConnection, adOpenStatic, adLockOptimistic
If objRecordset.BOF<>true and objRecordset.EOF<>true Then
If objRecordset.RecordCount<>0 Then
                                                Records_Count=objRecordset.RecordCount
Ret_Val=objRecordset.GetRows
else
Ret_Val="No Records Found"
End If
else
Ret_Val="No Records Found"
End If
objRecordset.Close
else
Ret_Val="Not Connected"
End If

objConnection.Close
Execute_Query= Ret_Val
       
End Function

Wsh Shell || Invoke Internet Explorer and navigating through an URL

There are couple of ways to invoke Internet Explorer and navigating through an URL.

Method 1:

Function Invoke_Browser(str_url)
On Error resume next
    'Create an IE browser object and invoke the URL
    Set obj_Brow_invok = createobject("InternetExplorer.Application")
    obj_Brow_invok .Visible = True
obj_Brow_invok .Navigate str_url
        Do While obj_Brow_invok .Busy Or obj_Brow_invok .readyState <> 4
            WScript.Sleep 50
        Loop
        Set obj_Brow_invok  = Nothing
End Function

Method 2:

Set WshShell = CreateObject("WScript.Shell")
WshShell.Run"iexplore.exe www.yahoo.com", 1
WScript.Sleep 50
Set WshShell = Nothing

Excel Class Library For Automation

Whenever our script fails in middle of our execution. we need to kill excel process from the task manager. So to get rid of this issue, we can use following code. The following code does all Excel operation with kill process errors.

Just copy this code and save into a vbs/qfl/dll File and add it your library Files.

Class ExcelDocument

Dim objExcel, objWorkbook, sheetcount
'--- Does necessary initialisation
Private Sub Class_Initialize
set objExcel= CreateObject("Excel.Application")
sheetcount=1
End Sub

'--- Destroys the excel object once the class is destroyed
Private Sub Class_Terminate
sheetcount=0
If Not IsEmpty(objWorkbook) Then
objExcel.Workbooks(1).Save
objWorkbook.Close
End If

objExcel.Quit
set objExcel= Nothing
End Sub


'--- Creates an excel object
Public Function CreateExcel(path_of_file)
Set objWorkbook = objExcel.Workbooks.Add()
objWorkbook.SaveAs(path_of_file)
End Function


'--- open an excel sheet
Public Function OpenExcel(path_of_file)
Set objWorkbook =objExcel.WorkBooks.Open(path_of_file)
End Function


'--- set visible status of an excel
Public Function VisibleState(state)
objExcel.Visible=state
End Function


'--- set visible status of an excel
Public Function AddSheet(sheetName)
objExcel.ActiveWorkbook.Worksheets.Add
objExcel.Sheets("Sheet"&sheetcount).Name=sheetName
objWorkbook.Save
sheetcount=sheetcount+1
End Function


'--- returns the excel object (better not to use until critical)
Public Function ReturnObject(sheetName)
ReturnObject=objWorkbook
End Function


'--- Inserts a "str" value at x,y pos
Public Function InsertAtCell(x,y,str)
objExcel.ActiveWorkbook.Activesheet.cells(x,y)=str
objWorkbook.Save
End Function


'--- insert "str" value in a sheet at x,y position in the current excel
Public Function InsertInSheet(sheetName,x,y,str)
objExcel.Sheets(sheetName).Activate
objExcel.ActiveWorkbook.Activesheet.cells(x,y)=str
objWorkbook.Save
End Function


'--- get value at cell x,y
Public Function ValueAtCell(x,y)
'       Msgbox x &"  "& y
' msgbox objExcel.ActiveWorkbook.Activesheet.cells(x,y)
ValueAtCell=objExcel.ActiveWorkbook.Activesheet.cells(x,y)
End Function


'--- Activate a sheet
Public Function ActivateSheet(sheetName)
objExcel.Sheets(sheetName).Activate
End Function


'--- Set the colour of a cell
Public Function SetCellColour(x,y,color)
objExcel.ActiveWorkbook.Activesheet.cells(x,y).Interior.ColorIndex=color
objWorkbook.Save
End Function


'--- set colour of a column
Public Function SetColumnColour(y,color)
objExcel.ActiveWorkbook.ActiveSheet.Range(y&"1",y&"65536").Interior.ColorIndex=color
objWorkbook.Save
End Function

'--- set colour for a row
Public Function SetRowcolour(y,color)
objExcel.ActiveWorkbook.ActiveSheet.Range("A"&y,"IV"&y).Interior.ColorIndex=color
objWorkbook.Save
End Function

'--- get the used rows count
Public Function UsedRows(sheetName)
UsedRows=objExcel.ActiveWorkbook.Activesheet.UsedRange.Rows.Count
End Function

'--- get used columns count
Public Function UsedColumns(sheetName)
UsedColumns=objExcel.ActiveWorkbook.Activesheet.UsedRange.Columns.Count
End Function

'--- set cell text colour
Public Function CellTextColour(x,y,color)
objExcel.ActiveWorkbook.Activesheet.cells(x,y).Font.ColorIndex=color
objWorkbook.Save
End Function

'--- set column text colour
Public Function ColumnTextColour(y,color)
objExcel.ActiveWorkbook.ActiveSheet.Range(y&"1",y&"65536").Font.ColorIndex=color
objWorkbook.Save
End Function

'--- set text colour of a row
Public Function RowTextColour(y,color)
objExcel.ActiveWorkbook.ActiveSheet.Range("A"&y,"IV"&y).Font.ColorIndex=color
objWorkbook.Save
End Function


End Class