Excel Macro to un-mute Audio/speakers.

FrancisM

FrancisM

Joined
Dec 13, 2017
Messages
71
Reaction score
19
I have been trying to find code to turn the users audio on. I have a user that mutes the speakers, using the icon in the lower right corner. The applications do have application speak, but requires audio. I am trying to find code to un-mute the audio. I was thinking about placing it in this workbook, under "Workbook_Open, Workbook Sheet Deactivate, Workbook Sheet Change, & Workbook Sheet Activate, as part of the current code. is that possible? I have found the following link, have been having trouble breaking it down to just the un-mute.

https://wellsr.com/vba/2016/excel/use-vba-to-mute-unmute-volume-up-volume-down/
 
FrancisM said:
I have been trying to find code to turn the users audio on. I have a user that mutes the speakers, using the icon in the lower right corner. The applications do have application speak, but requires audio. I am trying to find code to un-mute the audio. I was thinking about placing it in this workbook, under "Workbook_Open, Workbook Sheet Deactivate, Workbook Sheet Change, & Workbook Sheet Activate, as part of the current code. is that possible? I have found the following link, have been having trouble breaking it down to just the un-mute.

https://wellsr.com/vba/2016/excel/use-vba-to-mute-unmute-volume-up-volume-down/
Click to expand...


Try using this approach

msgroups.net - Diese Website steht zum Verkauf! - Informationen zum Thema msgroups.

Diese Website steht zum Verkauf! msgroups.net ist die beste Quelle für alle Informationen die Sie suchen. Von allgemeinen Themen bis hin zu speziellen Sachverhalten, finden Sie auf msgroups.net alles. Wir hoffen, dass Sie hier das Gesuchte finden!
msgroups.net msgroups.net
 
AmjiBhai said:
Try using this approach

msgroups.net - Diese Website steht zum Verkauf! - Informationen zum Thema msgroups.

Diese Website steht zum Verkauf! msgroups.net ist die beste Quelle für alle Informationen die Sie suchen. Von allgemeinen Themen bis hin zu speziellen Sachverhalten, finden Sie auf msgroups.net alles. Wir hoffen, dass Sie hier das Gesuchte finden!
msgroups.net msgroups.net
Click to expand...
Thank you for the link. The only question I have, is the placement of the Application.speech code.
 
After reading & studying the link that AmjiBhai was kind enough to provide. I have just learned that you must have access to the ADD in manager. I do not have access, it is administratively locked down. Is there any other option?
 
FrancisM said:
After reading & studying the link that AmjiBhai was kind enough to provide. I have just learned that you must have access to the ADD in manager. I do not have access, it is administratively locked down. Is there any other option?
Click to expand...
See if this gives you some clue:

I recommend you insert a new Module in your VBA window and paste the following code in that (new Module).


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Sub ChangeVolumeMute()
Dim oShell As Object
Set oShell = CreateObject("WScript.Shell")
exePath = "C:\Windows\SysWOW64"
exeName = "SndVol.exe"
oShell.CurrentDirectory = exePath
oShell.Run exeName & " " & cmdArgs, windowStyle, 1500


End Sub


Quote from Jezz81 https://stackoverflow.com/questions/21267283/error-running-shell-object-commands-through-excel-vba
'Key point being to set the CurrentDirectory property of the shell
EndQuote


I think you would need to insert appropriate values for cmdArgs....I am still searching the web
The good thing in this VBA code is that its responding and looks as if its quickly getting to(activating for some miliseconds time) the sound/speaker/volume object window
 
Last edited:
AmjiBhai said:
See if this gives you some clue:

I recommend you insert a new Module in your VBA window and paste the following code in that (new Module).


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Sub ChangeVolumeMute()
Dim oShell As Object
Set oShell = CreateObject("WScript.Shell")
exePath = "C:\Windows\SysWOW64"
exeName = "SndVol.exe"
oShell.CurrentDirectory = exePath
oShell.Run exeName & " " & cmdArgs, windowStyle, 1500


End Sub


Quote from Jezz81 https://stackoverflow.com/questions/21267283/error-running-shell-object-commands-through-excel-vba
'Key point being to set the CurrentDirectory property of the shell
EndQuote


I think you would need to insert appropriate values for cmdArgs....I am still searching the web
The good thing in this VBA code is that its responding and looks as if its quickly getting to(activating for some miliseconds time) the sound/speaker/volume object window
Click to expand...
I think you are correct regarding cmdArgs. I does appear that it is going to activate the speakers, but does not.
 
As soon as it activates sound speaker object use Sendkey {TAB} command so that it reaches the volume control or mute checkbox.... If we succeed in this ... :):)
 
AmjiBhai said:
As soon as it activates sound speaker object use Sendkey {TAB} command so that it reaches the volume control or mute checkbox.... If we succeed in this ... :):)
Click to expand...
Could you go into a little more detail. This way outside of my knowledge base. :)
 
FrancisM said:
Could you go into a little more detail. This way outside of my knowledge base. :)
Click to expand...
Sendkey is a wonderful command... It's often used when you invoke an application which popsup a user screen and want to pass on keys like ENTER, SPACEBAR, UPARROW, DOWN ARROW , ESC etc... Hence you are running other apps while remaining within excel ....for a better understanding I suggest you take a new vba project.... Use shell command to bring calculator and then see if you can use sendkey to do 2+2=4.... I am away from my laptop..... But I am sure you would love to do this ....this will enable you to handle sound mute and unmute...it's quite late in night here... Will get in touch with you tomorrow morning insha Allah.
 
Please pardon me and ignore my previous discussion....I started R&D on SendKeys and most fortunately found a better solution The keyword here is UI Automation (User Interface Automation)..... you got to download a file called inspect.exe (i hope its allowed by your admin) here is the link which explains with beautiful presentation...

Video Part 1
Video Part 2

please get macro-enabled sample file from here ....Code File Download Path https://drive.google.com/file/d/0B_mp...
 
Last edited:
I have made slight changes in the code as follows (with the help of Inspect.exe)......Things seem to be working ..... lets see....

Dim MyElement As UIAutomationClient.IUIAutomationElement
Dim MyElement1 As UIAutomationClient.IUIAutomationElement

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Enum oConditions
eUIA_NamePropertyId
eUIA_AutomationIdPropertyId
eUIA_ClassNamePropertyId
eUIA_LocalizedControlTypePropertyId
End Enum


Sub Test()
Dim AppObj As UIAutomationClient.IUIAutomationElement
Dim oInvokePattern As UIAutomationClient.IUIAutomationInvokePattern
Dim oAutomation As New CUIAutomation ' the UI Automation API\
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern

Set AppObj = WalkEnabledElements("Volume Mixer - Speakers (High Definition Audio Device)")

Set MyElement = AppObj.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_ClassNamePropertyId, "Mute Speakers"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "BTB Portal 3.0 KA - Internet Explorer"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_ClassNamePropertyId, "Shell DocObject View"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "http://ka.uhc.com/btb/"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Silverlight Control"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabMain"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Search"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabFindMain"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Plan Search"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "txtPolicyNumber"))

'Set oPattern = MyElement1.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

' MsgBox "Member ID - " & UIA_LegacyIAccessiblePatternId
'o_member_nbr
'
'Call GetElement(AppObj)
'
'
'
'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Unmute Speakers"))
'
Set oInvokePattern = MyElement.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
'oInvokePattern.Invoke


End Sub


Sub ClickOnceInstaller()
Dim AppObj As UIAutomationClient.IUIAutomationElement
Dim oInvokePattern As UIAutomationClient.IUIAutomationInvokePattern
Dim oAutomation As New CUIAutomation ' the UI Automation API\
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern

Set AppObj = oAutomation.GetRootElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "Volume Mixer - Speakers (High Definition Audio Device)"))

Set MyElement = AppObj.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "Unmute Speakers"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tableLayoutPanelButtons"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "btnCancel"))

Set oInvokePattern = MyElement.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
oInvokePattern.Invoke





Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "http://ka.uhc.com/btb/"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Silverlight Control"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabFindMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Plan Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "txtPolicyNumber"))

Set oPattern = MyElement1.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

MsgBox "Member ID - " & oPattern.CurrentValue
'o_member_nbr
'
'Call GetElement(AppObj)
'
'
'
'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Save"))
'
'Set oInvokePattern = MyElement1.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
'oInvokePattern.Invoke


End Sub



Function PropCondition(UiAutomation As CUIAutomation, Prop As oConditions, Requirement As String) As UIAutomationClient.IUIAutomationCondition
Select Case Prop
Case 0
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_NamePropertyId, Requirement)
Case 1
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_AutomationIdPropertyId, Requirement)
Case 2
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_ClassNamePropertyId, Requirement)
Case 3
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_LocalizedControlTypePropertyId, Requirement)
End Select
End Function


Function WalkEnabledElements(strWindowName As String) As UIAutomationClient.IUIAutomationElement
Dim oAutomation As New CUIAutomation
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Dim condition2 As UIAutomationClient.IUIAutomationCondition
Dim walker As UIAutomationClient.IUIAutomationTreeWalker
Dim element As UIAutomationClient.IUIAutomationElement

Set walker = oAutomation.ControlViewWalker
Set element = walker.GetFirstChildElement(oAutomation.GetRootElement)

Do While Not element Is Nothing
Debug.Print element.CurrentName
If InStr(1, element.CurrentName, strWindowName) > 0 Then
Set WalkEnabledElements = element
Exit Function
End If

Set element = walker.GetNextSiblingElement(element)
Loop
End Function

Function GetElement(elementalist As UIAutomationClient.IUIAutomationElement)
On Error Resume Next
Dim oAutomation As New CUIAutomation
Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Dim element1 As UIAutomationClient.IUIAutomationElementArray
Dim element2 As UIAutomationClient.IUIAutomationElement

Dim childtree As UIAutomationClient.TreeScope
Debug.Print elementalist.CurrentName
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Set condition1 = oAutomation.CreateTrueCondition
Set element1 = elementalist.FindAll(TreeScope_Children, condition1)
DoEvents
If element1.Length <> 0 Then
Set element2 = elementalist.FindFirst(TreeScope_Children, condition1)
End If

Do While Not element2 Is Nothing
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
Set oPattern = element2.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

Debug.Print element2.CurrentName & "|" & oPattern.CurrentValue

If oPattern.CurrentName = "Notification" Then
Set MyElement = element2
Exit Function
End If

Debug.Print element2.CurrentClassName

Debug.Print element2.CurrentAutomationId

GetElement element2
Debug.Print element2.CurrentName
If Not MyElement Is Nothing Then Exit Function
Set element2 = walker.GetNextSiblingElement(element2)
Loop

End Function

Function GetElement1(elementalist As UIAutomationClient.IUIAutomationElement)
On Error Resume Next
Dim oAutomation As New CUIAutomation
Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Dim element1 As UIAutomationClient.IUIAutomationElementArray
Dim element2 As UIAutomationClient.IUIAutomationElement

Dim childtree As UIAutomationClient.TreeScope
Debug.Print elementalist.CurrentName
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Set condition1 = oAutomation.CreateTrueCondition
Set element1 = elementalist.FindAll(TreeScope_Children, condition1)
DoEvents
If element1.Length <> 0 Then
Set element2 = elementalist.FindFirst(TreeScope_Children, condition1)
End If

Do While Not element2 Is Nothing
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
Set oPattern = element2.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

Debug.Print element2.CurrentName & "|" & oPattern.CurrentValue

If element2.CurrentName = "Save" Then
Set MyElement = element2
Exit Function
End If

Debug.Print element2.CurrentClassName

Debug.Print element2.CurrentAutomationId

GetElement element2
Debug.Print element2.CurrentName
If Not MyElement Is Nothing Then Exit Function
Set element2 = walker.GetNextSiblingElement(element2)
Loop

End Function



Function AddReference() As Boolean
Dim VBAEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim chkRef As VBIDE.Reference
Set VBAEditor = Application.VBE
Set vbProj = ThisWorkbook.VBProject

For Each chkRef In vbProj.References
If chkRef.Name Like "*IBM PCOMM 4.01*" Then
GoTo Flush
End If
Next
On Error GoTo Hell:
vbProj.References.AddFromFile Environ("systemroot") & "\system32\uiautomationcore.dll"

Hell:
If Err.Number = 48 Then
AddReference = False
ElseIf Err.Number = 0 Then
AddReference = True
End If
Flush:
Set vbProj = Nothing
Set VBAEditor = Nothing
End Function
 
I hope you have successfully installed inspect.exe...

Revised...(still in process.....not final yet)

Dim oAutomation As New CUIAutomation
Dim MyElement1 As UIAutomationClient.IUIAutomationElement
Dim MyElement2 As UIAutomationClient.IUIAutomationElement

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Enum oConditions
eUIA_NamePropertyId
eUIA_AutomationIdPropertyId
eUIA_ClassNamePropertyId
eUIA_LocalizedControlTypePropertyId
End Enum


Sub UIAutmationDemo()

Dim oInvokePattern As UIAutomationClient.IUIAutomationInvokePattern
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern



Set MyElement1 = WalkEnabledElements(oAutomation.GetRootElement, "Volume Mixer - Speakers (High Definition Audio Device)")

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, "UIA_ButtonControlTypeId", "ClsName"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "ClsName"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Silverlight Control"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabFindMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Plan Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "txtPolicyNumber"))

Set oPattern = MyElement1.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

MsgBox "Member ID - " & oPattern.CurrentValue
'o_member_nbr
'
'Call GetElement(AppObj)
'
'
'
'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Save"))
'
'Set oInvokePattern = MyElement1.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
'oInvokePattern.Invoke


End Sub


Sub ClickOnceInstaller()
Dim AppObj As UIAutomationClient.IUIAutomationElement
Dim oInvokePattern As UIAutomationClient.IUIAutomationInvokePattern
Dim oAutomation As New CUIAutomation ' the UI Automation API\
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern

Set AppObj = oAutomation.GetRootElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "TrustManagerPromptUI"))

Set MyElement = AppObj.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tableLayoutPanelOuter"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tableLayoutPanelButtons"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "btnCancel"))

Set oInvokePattern = MyElement.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
oInvokePattern.Invoke





Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "http://ka.uhc.com/btb/"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Silverlight Control"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabFindMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Plan Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "txtPolicyNumber"))

Set oPattern = MyElement1.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

MsgBox "Member ID - " & oPattern.CurrentValue
'o_member_nbr
'
'Call GetElement(AppObj)
'
'
'
'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Save"))
'
'Set oInvokePattern = MyElement1.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
'oInvokePattern.Invoke


End Sub



Function PropCondition(UiAutomation As CUIAutomation, Prop As oConditions, IdType As String) As UIAutomationClient.IUIAutomationCondition
Select Case IdType
Case "Name"
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_NamePropertyId, Requirement)
Case "AutoID"
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_AutomationIdPropertyId, Requirement)
Case "ClsName"
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_ClassNamePropertyId, Requirement)
Case LoczCon
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_LocalizedControlTypePropertyId, Requirement)
Case 50000
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_ButtonControlTypeId, Requirement)
'UIA_ButtonControlTypeId
End Select
End Function


Function WalkEnabledElements(element As UIAutomationClient.IUIAutomationElement, strWindowName As String) As UIAutomationClient.IUIAutomationElement

Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Set element = walker.GetFirstChildElement(element)

Do While Not element Is Nothing
Debug.Print element.CurrentName
If InStr(1, element.CurrentName, strWindowName) > 0 Then
Set WalkEnabledElements = element
Exit Function
End If

Set element = walker.GetNextSiblingElement(element)
Loop
End Function

Function GetElement(elementalist As UIAutomationClient.IUIAutomationElement)
On Error Resume Next
Dim oAutomation As New CUIAutomation
Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Dim element1 As UIAutomationClient.IUIAutomationElementArray
Dim element2 As UIAutomationClient.IUIAutomationElement

Dim childtree As UIAutomationClient.TreeScope
Debug.Print elementalist.CurrentName
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Set condition1 = oAutomation.CreateTrueCondition
Set element1 = elementalist.FindAll(TreeScope_Children, condition1)
DoEvents
If element1.Length <> 0 Then
Set element2 = elementalist.FindFirst(TreeScope_Children, condition1)
End If

Do While Not element2 Is Nothing
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
Set oPattern = element2.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

Debug.Print element2.CurrentName & "|" & oPattern.CurrentValue

If oPattern.CurrentName = "Notification" Then
Set MyElement = element2
Exit Function
End If

Debug.Print element2.CurrentClassName

Debug.Print element2.CurrentAutomationId

GetElement element2
Debug.Print element2.CurrentName
If Not MyElement Is Nothing Then Exit Function
Set element2 = walker.GetNextSiblingElement(element2)
Loop

End Function

Function GetElement1(elementalist As UIAutomationClient.IUIAutomationElement)
On Error Resume Next
Dim oAutomation As New CUIAutomation
Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Dim element1 As UIAutomationClient.IUIAutomationElementArray
Dim element2 As UIAutomationClient.IUIAutomationElement

Dim childtree As UIAutomationClient.TreeScope
Debug.Print elementalist.CurrentName
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Set condition1 = oAutomation.CreateTrueCondition
Set element1 = elementalist.FindAll(TreeScope_Children, condition1)
DoEvents
If element1.Length <> 0 Then
Set element2 = elementalist.FindFirst(TreeScope_Children, condition1)
End If

Do While Not element2 Is Nothing
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
Set oPattern = element2.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

Debug.Print element2.CurrentName & "|" & oPattern.CurrentValue

If element2.CurrentName = "Save" Then
Set MyElement = element2
Exit Function
End If

Debug.Print element2.CurrentClassName

Debug.Print element2.CurrentAutomationId

GetElement element2
Debug.Print element2.CurrentName
If Not MyElement Is Nothing Then Exit Function
Set element2 = walker.GetNextSiblingElement(element2)
Loop

End Function



Function AddReference() As Boolean
Dim VBAEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim chkRef As VBIDE.Reference
Set VBAEditor = Application.VBE
Set vbProj = ThisWorkbook.VBProject

For Each chkRef In vbProj.References
If chkRef.Name Like "*IBM PCOMM 4.01*" Then
GoTo Flush
End If
Next
On Error GoTo Hell:
vbProj.References.AddFromFile Environ("systemroot") & "\system32\uiautomationcore.dll"

Hell:
If Err.Number = 48 Then
AddReference = False
ElseIf Err.Number = 0 Then
AddReference = True
End If
Flush:
Set vbProj = Nothing
Set VBAEditor = Nothing
End Function
 
AmjiBhai said:
Please pardon me and ignore my previous discussion....I started R&D on SendKeys and most fortunately found a better solution The keyword here is UI Automation (User Interface Automation)..... you got to download a file called inspect.exe (i hope its allowed by your admin) here is the link which explains with beautiful presentation...

Video Part 1
Video Part 2

please get macro-enabled sample file from here ....Code File Download Path https://drive.google.com/file/d/0B_mp...
Click to expand...
I am not able to install. administration rules.
 
AmjiBhai said:
I have made slight changes in the code as follows (with the help of Inspect.exe)......Things seem to be working ..... lets see....

Dim MyElement As UIAutomationClient.IUIAutomationElement
Dim MyElement1 As UIAutomationClient.IUIAutomationElement

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Enum oConditions
eUIA_NamePropertyId
eUIA_AutomationIdPropertyId
eUIA_ClassNamePropertyId
eUIA_LocalizedControlTypePropertyId
End Enum


Sub Test()
Dim AppObj As UIAutomationClient.IUIAutomationElement
Dim oInvokePattern As UIAutomationClient.IUIAutomationInvokePattern
Dim oAutomation As New CUIAutomation ' the UI Automation API\
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern

Set AppObj = WalkEnabledElements("Volume Mixer - Speakers (High Definition Audio Device)")

Set MyElement = AppObj.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_ClassNamePropertyId, "Mute Speakers"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "BTB Portal 3.0 KA - Internet Explorer"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_ClassNamePropertyId, "Shell DocObject View"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "http://ka.uhc.com/btb/"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Silverlight Control"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabMain"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Search"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabFindMain"))

'Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Plan Search"))

'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "txtPolicyNumber"))

'Set oPattern = MyElement1.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

' MsgBox "Member ID - " & UIA_LegacyIAccessiblePatternId
'o_member_nbr
'
'Call GetElement(AppObj)
'
'
'
'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Unmute Speakers"))
'
Set oInvokePattern = MyElement.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
'oInvokePattern.Invoke


End Sub


Sub ClickOnceInstaller()
Dim AppObj As UIAutomationClient.IUIAutomationElement
Dim oInvokePattern As UIAutomationClient.IUIAutomationInvokePattern
Dim oAutomation As New CUIAutomation ' the UI Automation API\
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern

Set AppObj = oAutomation.GetRootElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "Volume Mixer - Speakers (High Definition Audio Device)"))

Set MyElement = AppObj.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "Unmute Speakers"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tableLayoutPanelButtons"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "btnCancel"))

Set oInvokePattern = MyElement.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
oInvokePattern.Invoke





Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "http://ka.uhc.com/btb/"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Silverlight Control"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "tabFindMain"))

Set MyElement = MyElement1.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Plan Search"))

Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_AutomationIdPropertyId, "txtPolicyNumber"))

Set oPattern = MyElement1.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

MsgBox "Member ID - " & oPattern.CurrentValue
'o_member_nbr
'
'Call GetElement(AppObj)
'
'
'
'Set MyElement1 = MyElement.FindFirst(TreeScope_Children, PropCondition(oAutomation, eUIA_NamePropertyId, "Save"))
'
'Set oInvokePattern = MyElement1.GetCurrentPattern(UIAutomationClient.UIA_InvokePatternId)
'oInvokePattern.Invoke


End Sub



Function PropCondition(UiAutomation As CUIAutomation, Prop As oConditions, Requirement As String) As UIAutomationClient.IUIAutomationCondition
Select Case Prop
Case 0
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_NamePropertyId, Requirement)
Case 1
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_AutomationIdPropertyId, Requirement)
Case 2
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_ClassNamePropertyId, Requirement)
Case 3
Set PropCondition = UiAutomation.CreatePropertyCondition(UIAutomationClient.UIA_LocalizedControlTypePropertyId, Requirement)
End Select
End Function


Function WalkEnabledElements(strWindowName As String) As UIAutomationClient.IUIAutomationElement
Dim oAutomation As New CUIAutomation
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Dim condition2 As UIAutomationClient.IUIAutomationCondition
Dim walker As UIAutomationClient.IUIAutomationTreeWalker
Dim element As UIAutomationClient.IUIAutomationElement

Set walker = oAutomation.ControlViewWalker
Set element = walker.GetFirstChildElement(oAutomation.GetRootElement)

Do While Not element Is Nothing
Debug.Print element.CurrentName
If InStr(1, element.CurrentName, strWindowName) > 0 Then
Set WalkEnabledElements = element
Exit Function
End If

Set element = walker.GetNextSiblingElement(element)
Loop
End Function

Function GetElement(elementalist As UIAutomationClient.IUIAutomationElement)
On Error Resume Next
Dim oAutomation As New CUIAutomation
Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Dim element1 As UIAutomationClient.IUIAutomationElementArray
Dim element2 As UIAutomationClient.IUIAutomationElement

Dim childtree As UIAutomationClient.TreeScope
Debug.Print elementalist.CurrentName
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Set condition1 = oAutomation.CreateTrueCondition
Set element1 = elementalist.FindAll(TreeScope_Children, condition1)
DoEvents
If element1.Length <> 0 Then
Set element2 = elementalist.FindFirst(TreeScope_Children, condition1)
End If

Do While Not element2 Is Nothing
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
Set oPattern = element2.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

Debug.Print element2.CurrentName & "|" & oPattern.CurrentValue

If oPattern.CurrentName = "Notification" Then
Set MyElement = element2
Exit Function
End If

Debug.Print element2.CurrentClassName

Debug.Print element2.CurrentAutomationId

GetElement element2
Debug.Print element2.CurrentName
If Not MyElement Is Nothing Then Exit Function
Set element2 = walker.GetNextSiblingElement(element2)
Loop

End Function

Function GetElement1(elementalist As UIAutomationClient.IUIAutomationElement)
On Error Resume Next
Dim oAutomation As New CUIAutomation
Dim walker As UIAutomationClient.IUIAutomationTreeWalker

Set walker = oAutomation.ControlViewWalker
Dim element1 As UIAutomationClient.IUIAutomationElementArray
Dim element2 As UIAutomationClient.IUIAutomationElement

Dim childtree As UIAutomationClient.TreeScope
Debug.Print elementalist.CurrentName
Dim condition1 As UIAutomationClient.IUIAutomationCondition
Set condition1 = oAutomation.CreateTrueCondition
Set element1 = elementalist.FindAll(TreeScope_Children, condition1)
DoEvents
If element1.Length <> 0 Then
Set element2 = elementalist.FindFirst(TreeScope_Children, condition1)
End If

Do While Not element2 Is Nothing
Dim oPattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
Set oPattern = element2.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)

Debug.Print element2.CurrentName & "|" & oPattern.CurrentValue

If element2.CurrentName = "Save" Then
Set MyElement = element2
Exit Function
End If

Debug.Print element2.CurrentClassName

Debug.Print element2.CurrentAutomationId

GetElement element2
Debug.Print element2.CurrentName
If Not MyElement Is Nothing Then Exit Function
Set element2 = walker.GetNextSiblingElement(element2)
Loop

End Function



Function AddReference() As Boolean
Dim VBAEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim chkRef As VBIDE.Reference
Set VBAEditor = Application.VBE
Set vbProj = ThisWorkbook.VBProject

For Each chkRef In vbProj.References
If chkRef.Name Like "*IBM PCOMM 4.01*" Then
GoTo Flush
End If
Next
On Error GoTo Hell:
vbProj.References.AddFromFile Environ("systemroot") & "\system32\uiautomationcore.dll"

Hell:
If Err.Number = 48 Then
AddReference = False
ElseIf Err.Number = 0 Then
AddReference = True
End If
Flush:
Set vbProj = Nothing
Set VBAEditor = Nothing
End Function
Click to expand...
Question. Where is this code placed?
 
FrancisM said:
Question. Where is this code placed?
Click to expand...
Insert a new Module say Module1 of a new macro-enabled or binary workbook....please run in step-mode[F8] to see exactly what's happening....

I am away...will join you next week in sha Allah.
 
FrancisM ! even if you don't have admin rights still there is a work around : you download Inspect.exe ...then you install it on your home pc/laptop....then do the code writing there at home....once it's ready copy it to your work place....

Believe me ...it's a great learning opportunity.... once you get through this stage successfully .... your skillfulness with get great heights.
Do watch the videos demonstrating the UI (user interface) + Inspect...!
 
Last edited:
Back
Top