Place mouse cursor over the link
Browser("Yahoo!").Page("Yahoo!").WebElement("text:=My Yahoo!").FireEvent "onmouseover"
wait 1
' Grab tooltip
ToolTip = Window("nativeclass:=tooltips_class32").GetROProperty("text"
Wednesday, December 16, 2009
count of links on a webpage
set odesc=desciption.create()
odesc("micclass").value="Link"
set cc=browser("creationtime:=0").page("micclass:=page").childobjects(odesc)
cc.count
odesc("micclass").value="Link"
set cc=browser("creationtime:=0").page("micclass:=page").childobjects(odesc)
cc.count
Get attachments from Quality centre
11. Get the Attachement from QC to local machine
To get attachment from test
Public Function GetTestAttachmentPath(TDAttachmentName) 'Returns File Path
'Test Director TDAPIOLELib object variables
Dim otaAttachmentFactory 'As TDAPIOLELib.AttachmentFactory
Dim otaAttachment 'As TDAPIOLELib.Attachment
Dim otaAttachmentList 'As TDAPIOLELib.List
Dim otaAttachmentFilter 'As TDAPIOLELib.TDFilter
Dim otaExtendedStorage 'As TDAPIOLELib.ExtendedStorage
Dim strPath 'As String
Set otaAttachmentFactory = QCUtil.CurrentTest.Attachments
Set otaAttachmentFilter = otaAttachmentFactory.Filter
otaAttachmentFilter.Filter("CR_REFERENCE") = "'TEST_" & QCUtil.CurrentTest.Id & "_" & TDAttachmentName & "'"
Set otaAttachmentList = otaAttachmentFilter.NewList
If otaAttachmentList.Count = 1 Then
Set otaAttachment = otaAttachmentList.Item(1)
otaAttachment.Load True, ""
strPath = otaAttachment.FileName
ElseIf otaAttachmentList.Count > 1 Then
Reporter.ReportEvent micFail, "Failure in library function 'GetTestAttachmentPath'", _ "Found more than one attachment '" & TDAttachmentName & "' in test '" & _ QCUtil.CurrentTest.Name & "'."
strPath = ""
ElseIf otaAttachmentList.Count < 1 Then
Reporter.ReportEvent micFail, "Failure in library function 'GetTestAttachmentPath'", _ "Found 0 attachments '" & TDAttachmentName & "' in test '" & _ QCUtil.CurrentTest.Name & "'."
strPath = ""
End If
GetTestAttachmentPath = strPath
Set otaAttachmentFactory = Nothing
Set otaAttachment = Nothing
Set otaAttachmentList = Nothing
Set otaAttachmentFilter = Nothing
End Function
To get attachment from folder
Public Function GetFolderAttachmentPath(TDAttachmentName, TDFolderPath) 'Returns File Path
'Test Director TDAPIOLELib object variables
Dim otaAttachmentFactory 'As TDAPIOLELib.AttachmentFactory
Dim otaAttachment 'As TDAPIOLELib.Attachment
Dim otaAttachmentList 'As TDAPIOLELib.List
Dim otaAttachmentFilter 'As TDAPIOLELib.TDFilter
Dim otaTreeManager 'As TDAPIOLELib.TreeManager
Dim otaSysTreeNode 'As TDAPIOLELib.SysTreeNode
Dim otaExtendedStorage 'As TDAPIOLELib.TreeManager
Dim intNdId
Dim strPath 'As String
Set otaTreeManager = QCUtil.TDConnection.TreeManager
Set otaSysTreeNode = otaTreeManager.NodeByPath(TDFolderPath)
Set otaAttachmentFactory = otaSysTreeNode.Attachments
Set otaAttachmentFilter = otaAttachmentFactory.Filter
intNdId = otaSysTreeNode.NodeID
otaAttachmentFilter.Filter("CR_REFERENCE") = "'ALL_LISTS_" & intNdId & "_" & TDAttachmentName & "'"
Set otaAttachmentList = otaAttachmentFilter.NewList
If otaAttachmentList.Count > 0 Then
Set otaAttachment = otaAttachmentList.Item(1)
otaAttachment.Load True, ""
strPath = otaAttachment.FileName
Else
Reporter.ReportEvent micFail,"Failure in library function 'GetFolderAttachmentPath'", _ "Failed to find attachment '" & TDAttachmentName & "' in folder '" & TDFolderPath & "'."
End If
GetFolderAttachmentPath = strPath
Set otaAttachmentFactory = Nothing
Set otaAttachment = Nothing
Set otaAttachmentList = Nothing
Set otaAttachmentFilter = Nothing
Set otaTreeManager = Nothing
Set otaSysTreeNode = Nothing
End Function
To get attachment from test
Public Function GetTestAttachmentPath(TDAttachmentName) 'Returns File Path
'Test Director TDAPIOLELib object variables
Dim otaAttachmentFactory 'As TDAPIOLELib.AttachmentFactory
Dim otaAttachment 'As TDAPIOLELib.Attachment
Dim otaAttachmentList 'As TDAPIOLELib.List
Dim otaAttachmentFilter 'As TDAPIOLELib.TDFilter
Dim otaExtendedStorage 'As TDAPIOLELib.ExtendedStorage
Dim strPath 'As String
Set otaAttachmentFactory = QCUtil.CurrentTest.Attachments
Set otaAttachmentFilter = otaAttachmentFactory.Filter
otaAttachmentFilter.Filter("CR_REFERENCE") = "'TEST_" & QCUtil.CurrentTest.Id & "_" & TDAttachmentName & "'"
Set otaAttachmentList = otaAttachmentFilter.NewList
If otaAttachmentList.Count = 1 Then
Set otaAttachment = otaAttachmentList.Item(1)
otaAttachment.Load True, ""
strPath = otaAttachment.FileName
ElseIf otaAttachmentList.Count > 1 Then
Reporter.ReportEvent micFail, "Failure in library function 'GetTestAttachmentPath'", _ "Found more than one attachment '" & TDAttachmentName & "' in test '" & _ QCUtil.CurrentTest.Name & "'."
strPath = ""
ElseIf otaAttachmentList.Count < 1 Then
Reporter.ReportEvent micFail, "Failure in library function 'GetTestAttachmentPath'", _ "Found 0 attachments '" & TDAttachmentName & "' in test '" & _ QCUtil.CurrentTest.Name & "'."
strPath = ""
End If
GetTestAttachmentPath = strPath
Set otaAttachmentFactory = Nothing
Set otaAttachment = Nothing
Set otaAttachmentList = Nothing
Set otaAttachmentFilter = Nothing
End Function
To get attachment from folder
Public Function GetFolderAttachmentPath(TDAttachmentName, TDFolderPath) 'Returns File Path
'Test Director TDAPIOLELib object variables
Dim otaAttachmentFactory 'As TDAPIOLELib.AttachmentFactory
Dim otaAttachment 'As TDAPIOLELib.Attachment
Dim otaAttachmentList 'As TDAPIOLELib.List
Dim otaAttachmentFilter 'As TDAPIOLELib.TDFilter
Dim otaTreeManager 'As TDAPIOLELib.TreeManager
Dim otaSysTreeNode 'As TDAPIOLELib.SysTreeNode
Dim otaExtendedStorage 'As TDAPIOLELib.TreeManager
Dim intNdId
Dim strPath 'As String
Set otaTreeManager = QCUtil.TDConnection.TreeManager
Set otaSysTreeNode = otaTreeManager.NodeByPath(TDFolderPath)
Set otaAttachmentFactory = otaSysTreeNode.Attachments
Set otaAttachmentFilter = otaAttachmentFactory.Filter
intNdId = otaSysTreeNode.NodeID
otaAttachmentFilter.Filter("CR_REFERENCE") = "'ALL_LISTS_" & intNdId & "_" & TDAttachmentName & "'"
Set otaAttachmentList = otaAttachmentFilter.NewList
If otaAttachmentList.Count > 0 Then
Set otaAttachment = otaAttachmentList.Item(1)
otaAttachment.Load True, ""
strPath = otaAttachment.FileName
Else
Reporter.ReportEvent micFail,"Failure in library function 'GetFolderAttachmentPath'", _ "Failed to find attachment '" & TDAttachmentName & "' in folder '" & TDFolderPath & "'."
End If
GetFolderAttachmentPath = strPath
Set otaAttachmentFactory = Nothing
Set otaAttachment = Nothing
Set otaAttachmentList = Nothing
Set otaAttachmentFilter = Nothing
Set otaTreeManager = Nothing
Set otaSysTreeNode = Nothing
End Function
puttty type in help
SystemUtil.Run "C:\Documents and Settings\raghu.alapati\Desktop\putty.exe"
wait(2)
Window("PuTTY Configuration").WinList("Saved Sessions").Select "xxx-lab"
wait(2)
Window("PuTTY Configuration").WinButton("Open").Click
wait(2)
Window("PuTTY").Type "password"
Window("PuTTY").Type micReturn
Window("PuTTY").Type "clear"
wait(2)
Window("PuTTY").Type micReturn
b=Window("PuTTY").GetVisibleText
msgbox b
wait(2)
Window("PuTTY Configuration").WinList("Saved Sessions").Select "xxx-lab"
wait(2)
Window("PuTTY Configuration").WinButton("Open").Click
wait(2)
Window("PuTTY").Type "password"
Window("PuTTY").Type micReturn
Window("PuTTY").Type "clear"
wait(2)
Window("PuTTY").Type micReturn
b=Window("PuTTY").GetVisibleText
msgbox b
Search text in a browser
TeextToSearch ="mywebLink"
if instr (ie.document.body.innerText, TeextToSearch) then
use DP and create a description
else
Msgbox “Link Not Found"
end if
if instr (ie.document.body.innerText, TeextToSearch) then
use DP and create a description
else
Msgbox “Link Not Found"
end if
Find HWND not hwnd..mind the differnce
Hwnd = extern.FindWindowEx(0,0,vbNullString, "Microsoft Internet Explorer")
lResult = extern.PostMessage(Hwnd, WM_COMMAND, buttonCode, 0)
lResult = extern.PostMessage(Hwnd, WM_COMMAND, buttonCode, 0)
Mercury device replay for mouse actions
use x,y to click on element using device replay
Set obj = CreateObject ("Mercury.DeviceReplay")
absx = Browser("..").Page("..").WebElement("..").GetROProperty("abs_x")
absy = Browser("..").Page("..").WebElement("..").GetROProperty("abs_y")
obj.MouseMove absx, absy
wait(3)
obj.MouseDown absx, absy, 0 '0 is for the Left Click
wait(3)
obj.MouseUp absx, absy, 0
Set obj = Nothing
Set obj = CreateObject ("Mercury.DeviceReplay")
absx = Browser("..").Page("..").WebElement("..").GetROProperty("abs_x")
absy = Browser("..").Page("..").WebElement("..").GetROProperty("abs_y")
obj.MouseMove absx, absy
wait(3)
obj.MouseDown absx, absy, 0 '0 is for the Left Click
wait(3)
obj.MouseUp absx, absy, 0
Set obj = Nothing
compare img files
'
'x=Browser("Tesco Internet Phone -_2").Page("Tesco Internet Phone -").Image("Generating...").Check (CheckPoint("Generating..._2"))
'print x
'Systemutil.Run "iexplore.exe","https://www.tescointernetphone.com/register/?reset=true",,,3
browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\testx.bmp",True
For j=1 to 20
browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").webelement("innerhtml:=Click here","index:=1").Click
wait(5)
browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\testx.bmp",True
wait(5)
fileAct = "c:\bm\testx.bmp"
For i= 1 to 150
fileExp ="C:\bm\test"&i&".bmp"
'fileExp="c:\bm\test2.bmp"
set oCompareUtil = CreateObject("Mercury.FileCompare")
if oCompareUtil.IsEqualBin(fileExp, fileAct, 0, 1) then
print i&"found"
print fileExp
msgbox i
Exit for
else
'print i&"doesnt match"
end if
set oCompareUtil = Nothing
Next
Next
'browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\test2.bmp",True
'
'For i=1 to 150
'browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\test"&i&".bmp",True
'
'browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").webelement("innerhtml:=Click here","index:=1").Click
'wait(5)
'Next
'
'x=Browser("Tesco Internet Phone -_2").Page("Tesco Internet Phone -").Image("Generating...").Check (CheckPoint("Generating..._2"))
'print x
'Systemutil.Run "iexplore.exe","https://www.tescointernetphone.com/register/?reset=true",,,3
browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\testx.bmp",True
For j=1 to 20
browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").webelement("innerhtml:=Click here","index:=1").Click
wait(5)
browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\testx.bmp",True
wait(5)
fileAct = "c:\bm\testx.bmp"
For i= 1 to 150
fileExp ="C:\bm\test"&i&".bmp"
'fileExp="c:\bm\test2.bmp"
set oCompareUtil = CreateObject("Mercury.FileCompare")
if oCompareUtil.IsEqualBin(fileExp, fileAct, 0, 1) then
print i&"found"
print fileExp
msgbox i
Exit for
else
'print i&"doesnt match"
end if
set oCompareUtil = Nothing
Next
Next
'browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\test2.bmp",True
'
'For i=1 to 150
'browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").image("alt:=Generating...").CaptureBitmap "c:\bm\test"&i&".bmp",True
'
'browser("title:=Tesco Internet Phone - .*").page("title:=Tesco Internet Phone -.*").webelement("innerhtml:=Click here","index:=1").Click
'wait(5)
'Next
'
close all apps except qtp
On Error Resume Next
Dim intWndCnt
Dim oDesc, oWnd
'Create Object description
Set oDesc = Description.Create '
Set oWnd = Desktop.ChildObjects(oDesc)
intWndCnt = oWnd.Count
For i = 0 to intWndCnt - 1
Set TmpObj = oWnd.item(i)
strTmpTitle = oWnd.item(i).GetROProperty("Text")
If instr(1,strTmpTitle, "Google - Windows Internet Explorer",1) > 0 Then
If instr(1,strTmpTitle, "Mercury Quality Center",1) > 0 Then
'msgbox "Title :" & oWnd.item(i).GetROProperty("Text")
Else
'msgbox "Close :" & oWnd.item(i).GetROProperty("Text")
oWnd.item(i).close
End if
End If
Next
'Clean up
Set oDesc = nothing
Set oWnd = nothing
Dim intWndCnt
Dim oDesc, oWnd
'Create Object description
Set oDesc = Description.Create '
Set oWnd = Desktop.ChildObjects(oDesc)
intWndCnt = oWnd.Count
For i = 0 to intWndCnt - 1
Set TmpObj = oWnd.item(i)
strTmpTitle = oWnd.item(i).GetROProperty("Text")
If instr(1,strTmpTitle, "Google - Windows Internet Explorer",1) > 0 Then
If instr(1,strTmpTitle, "Mercury Quality Center",1) > 0 Then
'msgbox "Title :" & oWnd.item(i).GetROProperty("Text")
Else
'msgbox "Close :" & oWnd.item(i).GetROProperty("Text")
oWnd.item(i).close
End if
End If
Next
'Clean up
Set oDesc = nothing
Set oWnd = nothing
clear cache and cookies in IE ..bit old school
call clearCookiesCatche("C:\DOCUME~1\%USERNAME%\Cookies")
call clearCookiesCatche("%temp%")
call clearCookiesCatche("C:\DOCUME~1\%USERNAME%\Locals~1\Tempor~1")
call clearCookiesCatche("C:\DOCUME~1\%USERNAME%\Locals~1\Tempor~1\Content.IE5")'for Xp Change according to ur OS
function clearCookiesCatche(path)
on Error Resume Next
set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set oFolder = fso.GetFolder(WshShell.ExpandEnvironmentStrings(path))
MsgBuffer=""
For Each oFile In oFolder.files
On Error Resume Next
fso.DeleteFile oFile
MsgBuffer =MsgBuffer& " "& oFile
Err.clear
Next
Wscript.Echo "Files Deletes ="&MsgBuffer
MsgBuffer=""
For Each oSubFolder In oFolder.SubFolders
On Error Resume Next
fso.DeleteFolder oSubFolder
MsgBuffer =MsgBuffer& " "& oSubFolder
Err.clear
Next
Wscript.Echo "Folder Deleted = "&MsgBuffer
set fso = nothing
set WshShell = nothing
set oFolder = nothing
Err.clear
end function
call clearCookiesCatche("%temp%")
call clearCookiesCatche("C:\DOCUME~1\%USERNAME%\Locals~1\Tempor~1")
call clearCookiesCatche("C:\DOCUME~1\%USERNAME%\Locals~1\Tempor~1\Content.IE5")'for Xp Change according to ur OS
function clearCookiesCatche(path)
on Error Resume Next
set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set oFolder = fso.GetFolder(WshShell.ExpandEnvironmentStrings(path))
MsgBuffer=""
For Each oFile In oFolder.files
On Error Resume Next
fso.DeleteFile oFile
MsgBuffer =MsgBuffer& " "& oFile
Err.clear
Next
Wscript.Echo "Files Deletes ="&MsgBuffer
MsgBuffer=""
For Each oSubFolder In oFolder.SubFolders
On Error Resume Next
fso.DeleteFolder oSubFolder
MsgBuffer =MsgBuffer& " "& oSubFolder
Err.clear
Next
Wscript.Echo "Folder Deleted = "&MsgBuffer
set fso = nothing
set WshShell = nothing
set oFolder = nothing
Err.clear
end function
check if an image is fully loaded on webpage
my code is like this:
set obj=Browser("name:=Blackboard.*").Page("title:=Blackboard.*").Frame("name:=main.*").object.all.tags("IMG")
msgbox obj.length
For each element in obj
s1=element.nameProp
If Browser().Page().Frame().Image("file name:="&s1,"index:=0").exist(0) then
If Browser().Page().Frame().Image("file name:="&s1,"index:=0").Object.complete="True" then
msgbox "pass"
else
msgbox "fail"
end if
end if
Next
set obj=Browser("name:=Blackboard.*").Page("title:=Blackboard.*").Frame("name:=main.*").object.all.tags("IMG")
msgbox obj.length
For each element in obj
s1=element.nameProp
If Browser().Page().Frame().Image("file name:="&s1,"index:=0").exist(0) then
If Browser().Page().Frame().Image("file name:="&s1,"index:=0").Object.complete="True" then
msgbox "pass"
else
msgbox "fail"
end if
end if
Next
broken links on webpage
set
obj=Browser("name:=Blackboard.*").Page("title:=Blackboard.*").Frame("name:=main.*").object.all.tags("IMG")
msgbox obj.length
For each element in obj
s1=element.nameProp
If Browser().Page().Frame().Image("file
name:="&s1,"index:=0").exist(0) then
If Browser().Page().Frame().Image("file
name:="&s1,"index:=0").Object.complete="True" then
msgbox "pass"
else
msgbox "fail"
end if
end if
Next
obj=Browser("name:=Blackboard.*").Page("title:=Blackboard.*").Frame("name:=main.*").object.all.tags("IMG")
msgbox obj.length
For each element in obj
s1=element.nameProp
If Browser().Page().Frame().Image("file
name:="&s1,"index:=0").exist(0) then
If Browser().Page().Frame().Image("file
name:="&s1,"index:=0").Object.complete="True" then
msgbox "pass"
else
msgbox "fail"
end if
end if
Next
control browser tabs
SystemUtil.Run "iexplore", "mail.yahoo.com","M:\","open","3"
b=browser("CreationTime:=3").exist
msgbox b
bb=browser("CreationTime:=0").GetROProperty("hwnd")
msgbox bb
set wc=window("hwnd:="&bb)
wc.Maximize
Set WshShell = CreateObject("WScript.Shell")
wait(3)
WshShell.SendKeys "^T"
'CreationTime
set hw1=browser("CreationTime:=0").Object.HWND
set cwindow=Window("hwnd:="&hw1.getroproperty("hwnd"))
cwindow.Maximze()
SystemUtil.Run "iexplore", "","M:\","open","3"
wait(8)
browser("creationTime:=0").sync
x=browser("creationTime:=0").getroproperty("hwnd")
msgbox x
ti=browser("hwnd:="&x).getroproperty("title")
msgbox ti
browser("hwnd:="&x).navigate("www.hotmail.com")
browser("creationTime:=0").navigate("www.hotmail.com")
browser("title:="&ti).navigate("www.yahoo.com")
cc=browser("title:=Blank Page - Windows Internet Explorer").Exist
msgbox cc
browser("title:=Blank Page - Windows Internet Explorer").Navigate "www.yahoo.com"
browser("title:=Blank Page - Windows Internet Explorer").OpenNewTab
browser("creationTime:=0").OpenNewTab
Browser("Browser").OpenNewTab
'Set WshShell = CreateObject("WScript.Shell")
'WshShell.SendKeys "^T"
b=browser("CreationTime:=3").exist
msgbox b
bb=browser("CreationTime:=0").GetROProperty("hwnd")
msgbox bb
set wc=window("hwnd:="&bb)
wc.Maximize
Set WshShell = CreateObject("WScript.Shell")
wait(3)
WshShell.SendKeys "^T"
'CreationTime
set hw1=browser("CreationTime:=0").Object.HWND
set cwindow=Window("hwnd:="&hw1.getroproperty("hwnd"))
cwindow.Maximze()
SystemUtil.Run "iexplore", "","M:\","open","3"
wait(8)
browser("creationTime:=0").sync
x=browser("creationTime:=0").getroproperty("hwnd")
msgbox x
ti=browser("hwnd:="&x).getroproperty("title")
msgbox ti
browser("hwnd:="&x).navigate("www.hotmail.com")
browser("creationTime:=0").navigate("www.hotmail.com")
browser("title:="&ti).navigate("www.yahoo.com")
cc=browser("title:=Blank Page - Windows Internet Explorer").Exist
msgbox cc
browser("title:=Blank Page - Windows Internet Explorer").Navigate "www.yahoo.com"
browser("title:=Blank Page - Windows Internet Explorer").OpenNewTab
browser("creationTime:=0").OpenNewTab
Browser("Browser").OpenNewTab
'Set WshShell = CreateObject("WScript.Shell")
'WshShell.SendKeys "^T"
close desired browser with print and Auto fade popup
SystemUtil.Run "iexplore", "mail.yahoo.com","M:\","open","3"
with browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").page("title:=Yahoo! Mail: The best web-based email!")
.sync
wait(3)
val=browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").GetROProperty("hwnd")
'window("hwnd:=" & val).type micF5
end with
Set sh=createobject("wscript.shell")
sh.Popup "ding",2,"ding1",(0+4)
' Print command
Dim bro
Set bro=description.Create
bro("micclass").value="Browser"
Set brow=desktop.ChildObjects(bro)
browco=brow.count
print browco
siteclose=inputbox("Enter your Site to Close",WebPage,"Enter Window Name")
For i=0 to browco-1
title=brow(i).getroproperty("title")
print "Browser Title is : "&title
Dim regEx,Match,Matches
Set regEx=New RegExp
regEx.pattern=siteclose
regEx.IgnoreCase=True
regEx.Global=True
Set Matches=regEx.Execute(title)
For Each Match in Matches
hnd=browser("title:="&title).getroproperty("hwnd")
'namee=browser("title:="&val).getroproperty("LocationName")
print title&" Page Found It is Closing now"
systemutil.CloseProcessByHwnd(hnd)
Next
Next
with browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").page("title:=Yahoo! Mail: The best web-based email!")
.sync
wait(3)
val=browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").GetROProperty("hwnd")
'window("hwnd:=" & val).type micF5
end with
Set sh=createobject("wscript.shell")
sh.Popup "ding",2,"ding1",(0+4)
' Print command
Dim bro
Set bro=description.Create
bro("micclass").value="Browser"
Set brow=desktop.ChildObjects(bro)
browco=brow.count
print browco
siteclose=inputbox("Enter your Site to Close",WebPage,"Enter Window Name")
For i=0 to browco-1
title=brow(i).getroproperty("title")
print "Browser Title is : "&title
Dim regEx,Match,Matches
Set regEx=New RegExp
regEx.pattern=siteclose
regEx.IgnoreCase=True
regEx.Global=True
Set Matches=regEx.Execute(title)
For Each Match in Matches
hnd=browser("title:="&title).getroproperty("hwnd")
'namee=browser("title:="&val).getroproperty("LocationName")
print title&" Page Found It is Closing now"
systemutil.CloseProcessByHwnd(hnd)
Next
Next
Auto fade msgbox or popup box
SystemUtil.Run "iexplore", "mail.yahoo.com","M:\","open","3"
with browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").page("title:=Yahoo! Mail: The best web-based email!")
.sync
wait(3)
val=browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").GetROProperty("hwnd")
'window("hwnd:=" & val).type micF5
end with
Set sh=createobject("wscript.shell")
sh.Popup "ding",2,"ding1",(0+4)
with browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").page("title:=Yahoo! Mail: The best web-based email!")
.sync
wait(3)
val=browser("title:=Yahoo! Mail: The best web-based email! - Windows Internet Explorer").GetROProperty("hwnd")
'window("hwnd:=" & val).type micF5
end with
Set sh=createobject("wscript.shell")
sh.Popup "ding",2,"ding1",(0+4)
Email through outlook
‘ Function: Outlook_SendEmail
‘
‘ Sends an email using Outlook.
‘
‘ Input Parameters:
‘
‘ strTo - The email address or Outlook contact to whom the email should be sent.
‘ strSubject - The email’s subject.
‘ strBody - The email’s body (this may of course include newline characters).
‘
‘ Output Parameters:
‘
‘ None.
‘
‘ Returns:
‘
‘ Not applicable. This is a sub, not a function.
‘
Sub Outlook_SendEmail(strTo, strSubject, strBody)
‘TODO: maybe add support for CC, BCC, etc?
‘Create an Outlook object
Dim Outlook ‘As New Outlook.Application
Set Outlook = CreateObject(”Outlook.Application”)
‘Create a new message
Dim Message ‘As Outlook.MailItem
Set Message = Outlook.CreateItem(0)
With Message
‘You can display the message To debug And see state
‘.Display
.Subject = Subject
.Body = TextBody
‘Set destination email address
.Recipients.Add (strTo)
‘Set sender address If specified.
‘Const olOriginator = 0
‘If Len(aFrom) > 0 Then .Recipients.Add(aFrom).Type = olOriginator
‘Send the message
.Send
End With
End Sub
‘
‘ Sends an email using Outlook.
‘
‘ Input Parameters:
‘
‘ strTo - The email address or Outlook contact to whom the email should be sent.
‘ strSubject - The email’s subject.
‘ strBody - The email’s body (this may of course include newline characters).
‘
‘ Output Parameters:
‘
‘ None.
‘
‘ Returns:
‘
‘ Not applicable. This is a sub, not a function.
‘
Sub Outlook_SendEmail(strTo, strSubject, strBody)
‘TODO: maybe add support for CC, BCC, etc?
‘Create an Outlook object
Dim Outlook ‘As New Outlook.Application
Set Outlook = CreateObject(”Outlook.Application”)
‘Create a new message
Dim Message ‘As Outlook.MailItem
Set Message = Outlook.CreateItem(0)
With Message
‘You can display the message To debug And see state
‘.Display
.Subject = Subject
.Body = TextBody
‘Set destination email address
.Recipients.Add (strTo)
‘Set sender address If specified.
‘Const olOriginator = 0
‘If Len(aFrom) > 0 Then .Recipients.Add(aFrom).Type = olOriginator
‘Send the message
.Send
End With
End Sub
.Net forms
set d=SwfWindow("regexpwndtitle:=MSN Messenger").SwfToolbar("swfname:=mainMenuStrip","swftypename:=System.Windows.Forms.MenuStrip")
d1=d.GetItemsCount
print d1
d.highlight
d.ShowDropdown 1
d1=d.GetItemsCount
print d1
d.highlight
d.ShowDropdown 1
Excel testsuite controller
Private Sub allset_Click()
On Error Resume Next
last = Range("B1000").End(xlUp).Row
Dim c As Range, myRange As Range
Set myRange = Selection
For Each c In myRange.Cells
ActiveSheet.CheckBoxes.Add(c.Left, c.Top, c.Width - 20, c.Height - 30).Select
With Selection
.LinkedCell = c.Address
.Characters.Text = "T"
.Name = c.Address
.Value = xlOn
.Caption = "chk" & Left(Range("A" & c.Row).Value, 3)
.Name = "chk" & Left(Range("A" & c.Row).Value, 3)
End With
c.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & c.Address & "=TRUE"
.FormatConditions(1).Font.ColorIndex = 4 'change for other color when ticked
.FormatConditions(1).Interior.ColorIndex = 4 'change for other color when ticked
.Font.ColorIndex = 3 'cell background color = White
.Interior.ColorIndex = 3
End With
Next
myRange.Select
End Sub
Private Sub CheckBox1_Click()
Dim i As Integer
If CheckBox1.Value Then
Range("c4").Interior.ColorIndex = 4
For i = 1 To 5
ActiveSheet.OLEObjects("CheckBox" & i + 1).Object.Value = 1
Range("c" & i + 4).Interior.ColorIndex = 4
Range("c" & i + 4).Value = "T"
Next i
Else
Range("c4").Interior.ColorIndex = 3
For i = 1 To 5
ActiveSheet.OLEObjects("CheckBox" & i + 1).Object.Value = 0
Range("c" & i + 4).Interior.ColorIndex = 3
Range("c" & i + 4).Value = "F"
Next i
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value Then
Range("C5").Interior.ColorIndex = 4
Else
Range("C5").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value Then
Range("C6").Interior.ColorIndex = 4
Else
Range("C6").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox4_Click()
If CheckBox4.Value Then
Range("C7").Interior.ColorIndex = 4
Else
Range("C7").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox5_Click()
If CheckBox5.Value Then
Range("C8").Interior.ColorIndex = 4
Else
Range("C8").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox6_Click()
If CheckBox6.Value Then
Range("C9").Interior.ColorIndex = 4
Else
Range("C9").Interior.ColorIndex = 3
End If
End Sub
Private Sub chkallset_Click()
Dim i As Integer
last = Range("A1000").End(xlUp).Row
last = last + 1
If chkallset.Value Then
Range("B3").Interior.ColorIndex = 6
j = 101
For i = 1 To last - 3
If Range("B" & i + 3).Interior.ColorIndex <> -4142 Then
ActiveSheet.CheckBoxes("chk" & j).Value = 1
'Range("c" & i + 4).Interior.ColorIndex = 6
j = j + 1
Else
j = j + 1
End If
Next i
Else
Range("B3").Interior.ColorIndex = 3
j = 101
For i = 1 To last - 3
If Range("B" & i + 3).Interior.ColorIndex <> -4142 Then
ActiveSheet.CheckBoxes("chk" & j).Value = 0
'Range("c" & i + 4).Interior.ColorIndex = 3
j = j + 1
Else
j = j + 1
End If
Next
End If
End Sub
Private Sub CommandButton2_Click()
Dim x
Dim day1, day2, day3, day4, day5, day6, day7 As Integer
Dim dd As String
Dim ft As Integer
Set oService = GetObject("winmgmts:")
Set oJob = oService.Get("Win32_ScheduledJob")
If Range("F5").Value = 1 Then
x = Range("Mdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 1, , , JobID
Range("F6").Value = JobID
Else
Range("F6").Value = ""
End If
If Range("G5").Value = 1 Then
x = Range("Tdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 2, , , JobID
Range("G6").Value = JobID
Else
Range("G6").Value = ""
End If
If Range("H5").Value = 1 Then
x = Range("Wdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 4, , , JobID
Range("H6").Value = JobID
Else
Range("H6").Value = ""
End If
If Range("I5").Value = 1 Then
x = Range("Thdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 8, , , JobID
Range("I6").Value = JobID
Else
Range("I6").Value = ""
End If
If Range("J5").Value = 1 Then
x = Range("Fdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 16, , , JobID
Range("J6").Value = JobID
Else
Range("J6").Value = ""
End If
If Range("K5").Value = 1 Then
x = Range("Sdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 32, , , JobID
Range("K6").Value = JobID
Else
Range("K6").Value = ""
End If
If Range("L5").Value = 1 Then
x = Range("Sudate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 64, , , JobID
Range("L6").Value = JobID
Else
Range("L6").Value = ""
End If
End Sub
Private Sub Deletesch_Click()
Set odService1 = GetObject("winmgmts:")
Dim A(10) As Integer
A(1) = Range("F6").Value
A(2) = Range("G6").Value
A(3) = Range("H6").Value
A(4) = Range("I6").Value
A(5) = Range("J6").Value
A(6) = Range("K6").Value
A(7) = Range("L6").Value
For i = 1 To 7
If A(i) >= 1 And A(i) < 1000 Then
Set objInstance = odService1.Get("Win32_ScheduledJob.JobID=" & A(i))
objInstance.Delete
Set objInstance = Nothing
End If
Next
Range("F6").Value = ""
Range("G6").Value = ""
Range("H6").Value = ""
Range("I6").Value = ""
Range("J6").Value = ""
Range("K6").Value = ""
Range("L6").Value = ""
End Sub
Private Sub res_Click()
Dim i As Integer
Dim counter As Integer
Dim lastc As Integer
Dim tempc As Integer
tempc = 0
last = Range("E1000").End(xlUp).Row
lastc = 0
counter1 = 0
For i = 4 To last - 3
If Range("E" & i).Value = "Pass" Then
counter1 = counter1 + 1
ElseIf Range("E" & i).Value = "Fail" Then
lastc = lastc + 1
Else
tempc = tempc + 1
End If
Next
Range("F15").Value = lastc + counter1
Range("F16").Value = counter1
Range("F17").Value = lastc
With ActiveSheet.ChartObjects.Add _
(Left:=500, Width:=375, Top:=500, Height:=225)
.Chart.SetSourceData Source:=Sheets("Sheet1").Range("F15:F17")
.Chart.HasTitle = True
.Chart.ChartTitle.Text = Range("A1").Value & " " & Date
' for y axis
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "col 1 for total run, col 2 for pass, col 3 for fail"
.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = " total run " & lastc + counter1 & " ,Pass " & counter1 & ", Fail " & lastc & ",Unrun count " & tempc & "."
.Chart.Export Filename:="c:\current_sales.gif", FilterName:="GIF"
End With
End Sub
On Error Resume Next
last = Range("B1000").End(xlUp).Row
Dim c As Range, myRange As Range
Set myRange = Selection
For Each c In myRange.Cells
ActiveSheet.CheckBoxes.Add(c.Left, c.Top, c.Width - 20, c.Height - 30).Select
With Selection
.LinkedCell = c.Address
.Characters.Text = "T"
.Name = c.Address
.Value = xlOn
.Caption = "chk" & Left(Range("A" & c.Row).Value, 3)
.Name = "chk" & Left(Range("A" & c.Row).Value, 3)
End With
c.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & c.Address & "=TRUE"
.FormatConditions(1).Font.ColorIndex = 4 'change for other color when ticked
.FormatConditions(1).Interior.ColorIndex = 4 'change for other color when ticked
.Font.ColorIndex = 3 'cell background color = White
.Interior.ColorIndex = 3
End With
Next
myRange.Select
End Sub
Private Sub CheckBox1_Click()
Dim i As Integer
If CheckBox1.Value Then
Range("c4").Interior.ColorIndex = 4
For i = 1 To 5
ActiveSheet.OLEObjects("CheckBox" & i + 1).Object.Value = 1
Range("c" & i + 4).Interior.ColorIndex = 4
Range("c" & i + 4).Value = "T"
Next i
Else
Range("c4").Interior.ColorIndex = 3
For i = 1 To 5
ActiveSheet.OLEObjects("CheckBox" & i + 1).Object.Value = 0
Range("c" & i + 4).Interior.ColorIndex = 3
Range("c" & i + 4).Value = "F"
Next i
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value Then
Range("C5").Interior.ColorIndex = 4
Else
Range("C5").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value Then
Range("C6").Interior.ColorIndex = 4
Else
Range("C6").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox4_Click()
If CheckBox4.Value Then
Range("C7").Interior.ColorIndex = 4
Else
Range("C7").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox5_Click()
If CheckBox5.Value Then
Range("C8").Interior.ColorIndex = 4
Else
Range("C8").Interior.ColorIndex = 3
End If
End Sub
Private Sub CheckBox6_Click()
If CheckBox6.Value Then
Range("C9").Interior.ColorIndex = 4
Else
Range("C9").Interior.ColorIndex = 3
End If
End Sub
Private Sub chkallset_Click()
Dim i As Integer
last = Range("A1000").End(xlUp).Row
last = last + 1
If chkallset.Value Then
Range("B3").Interior.ColorIndex = 6
j = 101
For i = 1 To last - 3
If Range("B" & i + 3).Interior.ColorIndex <> -4142 Then
ActiveSheet.CheckBoxes("chk" & j).Value = 1
'Range("c" & i + 4).Interior.ColorIndex = 6
j = j + 1
Else
j = j + 1
End If
Next i
Else
Range("B3").Interior.ColorIndex = 3
j = 101
For i = 1 To last - 3
If Range("B" & i + 3).Interior.ColorIndex <> -4142 Then
ActiveSheet.CheckBoxes("chk" & j).Value = 0
'Range("c" & i + 4).Interior.ColorIndex = 3
j = j + 1
Else
j = j + 1
End If
Next
End If
End Sub
Private Sub CommandButton2_Click()
Dim x
Dim day1, day2, day3, day4, day5, day6, day7 As Integer
Dim dd As String
Dim ft As Integer
Set oService = GetObject("winmgmts:")
Set oJob = oService.Get("Win32_ScheduledJob")
If Range("F5").Value = 1 Then
x = Range("Mdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 1, , , JobID
Range("F6").Value = JobID
Else
Range("F6").Value = ""
End If
If Range("G5").Value = 1 Then
x = Range("Tdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 2, , , JobID
Range("G6").Value = JobID
Else
Range("G6").Value = ""
End If
If Range("H5").Value = 1 Then
x = Range("Wdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 4, , , JobID
Range("H6").Value = JobID
Else
Range("H6").Value = ""
End If
If Range("I5").Value = 1 Then
x = Range("Thdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 8, , , JobID
Range("I6").Value = JobID
Else
Range("I6").Value = ""
End If
If Range("J5").Value = 1 Then
x = Range("Fdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 16, , , JobID
Range("J6").Value = JobID
Else
Range("J6").Value = ""
End If
If Range("K5").Value = 1 Then
x = Range("Sdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 32, , , JobID
Range("K6").Value = JobID
Else
Range("K6").Value = ""
End If
If Range("L5").Value = 1 Then
x = Range("Sudate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 64, , , JobID
Range("L6").Value = JobID
Else
Range("L6").Value = ""
End If
End Sub
Private Sub Deletesch_Click()
Set odService1 = GetObject("winmgmts:")
Dim A(10) As Integer
A(1) = Range("F6").Value
A(2) = Range("G6").Value
A(3) = Range("H6").Value
A(4) = Range("I6").Value
A(5) = Range("J6").Value
A(6) = Range("K6").Value
A(7) = Range("L6").Value
For i = 1 To 7
If A(i) >= 1 And A(i) < 1000 Then
Set objInstance = odService1.Get("Win32_ScheduledJob.JobID=" & A(i))
objInstance.Delete
Set objInstance = Nothing
End If
Next
Range("F6").Value = ""
Range("G6").Value = ""
Range("H6").Value = ""
Range("I6").Value = ""
Range("J6").Value = ""
Range("K6").Value = ""
Range("L6").Value = ""
End Sub
Private Sub res_Click()
Dim i As Integer
Dim counter As Integer
Dim lastc As Integer
Dim tempc As Integer
tempc = 0
last = Range("E1000").End(xlUp).Row
lastc = 0
counter1 = 0
For i = 4 To last - 3
If Range("E" & i).Value = "Pass" Then
counter1 = counter1 + 1
ElseIf Range("E" & i).Value = "Fail" Then
lastc = lastc + 1
Else
tempc = tempc + 1
End If
Next
Range("F15").Value = lastc + counter1
Range("F16").Value = counter1
Range("F17").Value = lastc
With ActiveSheet.ChartObjects.Add _
(Left:=500, Width:=375, Top:=500, Height:=225)
.Chart.SetSourceData Source:=Sheets("Sheet1").Range("F15:F17")
.Chart.HasTitle = True
.Chart.ChartTitle.Text = Range("A1").Value & " " & Date
' for y axis
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "col 1 for total run, col 2 for pass, col 3 for fail"
.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = " total run " & lastc + counter1 & " ,Pass " & counter1 & ", Fail " & lastc & ",Unrun count " & tempc & "."
.Chart.Export Filename:="c:\current_sales.gif", FilterName:="GIF"
End With
End Sub
Subscribe to:
Comments (Atom)
