Visual basic for a rightkey command

[Zakynthos]

I need to right click an icon in an explorer window of a database, which only
seems to work with a right mouse click. I've tried the right click key on
the keyboard and it doesn't work.

I've also tried other key combinations to see if I could simulate the right
mouse click with a sendkeys statement such as ctrl and f10 but that doesn't
work either.

Is there a way of creating this rightclick in Visualbasic code?

Many thanks.

 

[RB Smissaert]

You could try API code like this:

Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
Private Declare Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Declare Function GetCursorPos _
Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function SetCursorPos Lib _
"user32" (ByVal x As Long, _
ByVal y As Long) As Long

Sub SendMouseClick(Optional lX As Long = -1, _
Optional lY As Long = -1, _
Optional bRightClick As Boolean)

'NOTE: lX and lY are assumed to be Screen coordinates
' relative to the uper left corner (0, 0)
'----------------------------------------------------
Dim lFlags As Long
Dim Point As POINTAPI
Dim bReturn As Boolean

'get the mouse cursor position to return to
GetCursorPos Point

'Set cursor position
If lX > -1 Then
SetCursorPos lX, lY
bReturn = True
Else
lX = Point.x
lY = Point.y
End If

DoEvents

'Send the mouse event
If bRightClick Then
lFlags = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_ABSOLUTE
Else
lFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE
End If

mouse_event lFlags, lX, lY, 0, 0
DoEvents

If bRightClick Then
lFlags = MOUSEEVENTF_RIGHTUP Or MOUSEEVENTF_ABSOLUTE
Else
lFlags = MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE
End If

mouse_event lFlags, lX, lY, 0, 0
DoEvents

'return to the old mouse position
If bReturn Then
SetCursorPos Point.x, Point.y
DoEvents
End If

End Sub

Function GetCursorPosition() As Variant

Dim Point As POINTAPI
Dim arr(1 To 2) As Long

'get the mouse cursor position to return to
GetCursorPos Point

arr(1) = Point.x
arr(2) = Point.y

GetCursorPosition = arr

End Function


Sub test()

SendMouseClick , , False

End Sub


RBS

 

[Joel]

Everything is declared. You don't need to do anything.

 

[Zakynthos]

Thanks for this - I've run it from Excel and don't get an error message -
except nothing seems to be happening!!! - other than a slight flicker in the
Excel window when I click the button

The problem is that I need to send the right click to another program in a
window titled "WFM Configuration Utility - Contracts" and then go one down
in the pop up box and send an 'Enter' to select the first option - I have
tried puting the following code into the Test subroutine as follows:

Sub test()
AppActivate "WFM Configuration Utility - Contracts"

With ThisWorkbook.Sheets("Sheet1")

SendMouseClick , , False
End With
End Sub

Can you point me in the right direction to get this code working?

 

[Joel]

You need to run the GetCursor Position routine to return the X and Y location
of the menu item you are looking for. Then hard code these number into the
1st tow paramters of the SendMouseClick () function.

 

[Zakynthos]

Joel,

Could you let me have an example of the GetCursor POsition coding and tell
me where in the API routine I should place it?

Thanks

 

[Joel]

Use this code to call the GetcursorPosition function in RB Smissaert macros.

Sub Displaycursor()
Dim Pos As Variant

Pos = GetCursorPosition()
MsgBox ("X : " & Pos(1))
MsgBox ("Y : " & Pos(2))

End Sub

 

[Zakynthos]

Joel,

I've pasted this code in before the the following function:

Function GetCursorPosition() As Variant

Dim Point As POINTAPI
Dim arr(1 To 2) As Long

'get the mouse cursor position to return to
GetCursorPos Point

arr(1) = Point.x
arr(2) = Point.y

GetCursorPosition = arr

End Function

Doesn't seem to work!

What do I need to do now to get this right click working? Also, if and when
I succeed how will I then get a 'down' and and 'enter' function to that
window in order to select the first item in the list?
Many thanks.

 

[Joel]

You have to set the mouse position and then right click. the code I provided
will get you the X,Y Postion . You then need to set the cursor position
before you right click. You can activate the window using the AppActivate()
function.

 

[Zakynthos]

Joel,

Perfect! thanks for thatnow have coordinates and script runs but one last
problem - the right click seems to be working becasue the icon is flickering
when I send the script but it's only a flicker! I've then used sendkeys to
send a 'down' and an 'enter' to select and enter the first item in the pop up
window but they don't work because, I think the right click is too brief to
activate the pop-up box(???)

If this is likely to be the problem, then can I send a 'wait' command or
include a script to 'hold' the right mouse click?

Many thanks,

Zak

 

[Joel]

add a delay between mouse down and mouse up in the code below

'Send the mouse event
If bRightClick Then
lFlags = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_ABSOLUTE
Else
lFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE
End If

mouse_event lFlags, lX, lY, 0, 0
DoEvents

'Delay
'------------------------------------------------------
If Application.Wait(Now + TimeValue("0:00:01")) Then
MsgBox "Time expired"
End If
'------------------------------------------------------

If bRightClick Then
lFlags = MOUSEEVENTF_RIGHTUP Or MOUSEEVENTF_ABSOLUTE
Else
lFlags = MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE
End If