Showing posts with label TechNotebook. Show all posts
Showing posts with label TechNotebook. Show all posts

Sunday, June 21, 2020

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;

public class playPianoFuncs {
//launch application
public static WebDriver launchApplication(String url)
WebDriver drv=null;
System.setProperty("", keyConstants.chromeDriverPath);
// Initialize browser
drv=new ChromeDriver();
// Open url
// Maximize browser
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":[octave];break;
case "ab": keyNum=keyConstants.ab[octave];break;
case "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));
int playTime=keyConstants.kaalam1;
if(string.length()==2) {playTime=keyConstants.kaalam2;string=string.substring(0, 1);}
int ky=playPianoFuncs.getKeyNumbers(octave,string);
//System.out.println("Key number:"+ky);
WebElement key=drv.findElement(By.cssSelector("*["+keyConstants.keyboardAttribute+"='"+ky+"']"));;

Constants File:

package playPiano;

public class keyConstants {
//Octave (Low-0, Medium-1, High-2)
//public static int LMH=1;
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="";
//time parameters
public static int commonTimeOut=120;
public static int httpConnTimeOut=120000;
//Piano specific attribute
public static String keyboardAttribute="data-key";

Monday, May 11, 2020

Socks problem - Can you help me with better logic ?


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

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


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


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)
            if(lvl==-1) valleyFlag=true;
        return vc;

Wednesday, October 30, 2019

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
    For rw = 3 To Sheet1.UsedRange.Rows.Count
        findWord = "<" & Sheet1.Cells(rw, 2) & ">"
        replaceWith = Sheet1.Cells(rw, 3)
        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
    wordapp.Visible = True
    'Set wordapp = Nothing
End Sub

Monday, October 7, 2019

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" );
document.onmousedown=new Function ("return false" );
document.onmouseup=new Function ("return false");

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")//-->

Thursday, September 12, 2019

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


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 !!


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:

Monday, February 19, 2018

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
        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)
        Sheet2.Cells(eR, 1) = "Successfull"
    End If
'Set TestPlanFilter = Nothing
'Set myTestPlan = Nothing
'Set TestList = Nothing
'Set TestPlanFilter = Nothing
    Application.StatusBar = err.Description
    Sheet2.Cells(k, 1) = err.Description
End Sub

Thursday, February 15, 2018

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
            allScriptsNames = allScriptsNames & "##" & Sheet1.Cells(rI, 5) & "##" & Sheet1.Cells(rI, 6)
        End If

    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)
            End If
        Next tsTest
    Next testsetfound


    Application.StatusBar = "Logged Out"
    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

Monday, July 31, 2017

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

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 

Wednesday, December 9, 2015

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.

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)
   for(int iRow=0;iRow<tab.length;iRow++)
   for(int iCol=0;iCol<tab[0].length;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(grps.containsKey(top))//group already created
        else //create new group
 if(c>0)//not first in columns
        if(grps.containsKey(left))//group already created
        else //create new group

Friday, September 25, 2015

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
        Set extStor = myComp.ExtendedStorage(0)
        extStor.ClientPath = "C:\Backup\ECC\Login"
         extStor.Save "-r *.*", True
        myComp.Name = "DefaultValidName"
        MsgBox errString
    End If
    'Loads all the files from the directory
 '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
    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
 End If
 ''Log off the server
 If tdc.LoggedIn Then
 End If
 ''Release the TDConnection object
 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 *

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.echo "note pad window found"

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

 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 & ")")

Friday, January 9, 2015

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
    'Except current wscript, kill all the other wscripts running on the system
    For Each objProcess In colProcess
        If cpid <> objProcess.ProcessId Then
        End If
    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")


               Set WshSysUserEnv= Nothing

End Function

Saturday, June 21, 2014

VB Scirpt || ADODB Connection Code

PUBLIC Records_Count

DB_ServerConn_String = "HOST=< Server IP addr or name>;PORT=<server prot num>;SERVICE_NAME=<servicename or sid>;uid=<Username>;pwd=<password>"
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
objRecordset.CursorLocation = adUseClient
objRecordset.Open QueryString , objConnection, adOpenStatic, adLockOptimistic
If objRecordset.BOF<>true and objRecordset.EOF<>true Then
If objRecordset.RecordCount<>0 Then
Ret_Val="No Records Found"
End If
Ret_Val="No Records Found"
End If
Ret_Val="Not Connected"
End If

Execute_Query= Ret_Val
End Function

Saturday, May 17, 2014

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
        Set obj_Brow_invok  = Nothing
End Function

Method 2:

Set WshShell = CreateObject("WScript.Shell")
WshShell.Run"iexplore.exe", 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")
End Sub

'--- Destroys the excel object once the class is destroyed
Private Sub Class_Terminate
If Not IsEmpty(objWorkbook) Then
End If

set objExcel= Nothing
End Sub

'--- Creates an excel object
Public Function CreateExcel(path_of_file)
Set objWorkbook = objExcel.Workbooks.Add()
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)
End Function

'--- set visible status of an excel
Public Function AddSheet(sheetName)
End Function

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

'--- Inserts a "str" value at x,y pos
Public Function InsertAtCell(x,y,str)
End Function

'--- insert "str" value in a sheet at x,y position in the current excel
Public Function InsertInSheet(sheetName,x,y,str)
End Function

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

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

'--- Set the colour of a cell
Public Function SetCellColour(x,y,color)
End Function

'--- set colour of a column
Public Function SetColumnColour(y,color)
End Function

'--- set colour for a row
Public Function SetRowcolour(y,color)
End Function

'--- get the used rows count
Public Function UsedRows(sheetName)
End Function

'--- get used columns count
Public Function UsedColumns(sheetName)
End Function

'--- set cell text colour
Public Function CellTextColour(x,y,color)
End Function

'--- set column text colour
Public Function ColumnTextColour(y,color)
End Function

'--- set text colour of a row
Public Function RowTextColour(y,color)
End Function

End Class