How to trap a LEFT click mouse event in Excel VBA?

[Ace_McCloud]

Usage: I want to add a list of Companies to an Excel spreadsheet. The Companies are obtained from Screener.in. I want to trap LEFT Click (so that when I LEFT Click on a Company, it will be added to my Excel Spreadsheet)

Note: I've already posted the same question on stackoverflow. Here's the link:

https://stackoverflow.com/questions/...24324_47968379

Option Explicit
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
' Declare virtual key event listener
 Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
 Private Declare Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
' Left mouse button
 Private Const VK_LBUTTON = &H1
' Right mouse button
 Private Const VK_RBUTTON = &H2

 Private Const VK_F9 = &H78

 Enum BrowserNavConstants
        navOpenInNewWindow = 1
        navNoHistory = 2
        navNoReadFromCache = 4
        navNoWriteToCache = 8
        navAllowAutosearch = 16
        navBrowserBar = 32
        navHyperlink = 64
        navEnforceRestricted = 128
        navNewWindowsManaged = 256
        navUntrustedForDownload = 512
        navTrustedForActiveX = 1024
        navOpenInNewTab = 2048
        navOpenInBackgroundTab = 4096
        navKeepWordWheelText = 8192
        navVirtualTab = 16384
        navBlockRedirectsXDomain = 32768
        navOpenNewForegroundTab = 65536
 End Enum

 Function OpenNewTab(ByVal CTA As Variant, IE As Variant)

    Dim SubStrings() As String
    Dim Substitute As String
    Dim Url As String

    Substitute = "https://www.screener.in"

'    Debug.Print CTA

    SubStrings = Split(CTA, """")

'    /^<a href="([^"]++)".*?<\/a>/gm
'    [url]https://www.screener.in\1[/url]

'    Debug.Print Substitute & SubStrings(1)

    Url = Substitute & SubStrings(1)

    IE.Visible = True
    IE.Navigate Url, BrowserNavConstants.navOpenInNewTab

 End Function


 Sub SearchAndGetCompanyList()
    Dim SW As SHDocVw.ShellWindows
    Dim IE As SHDocVw.InternetExplorer
    Dim Sh As Worksheet
    Dim Url As String
    Dim SUrl, DUrl, RUrl As MSHTML.HTMLDocument
    Dim Login, RunThisQuery As MSHTML.HTMLButtonElement
    Dim Table As MSHTML.HTMLTable
    Dim TableRowCollection As MSHTML.IHTMLElementCollection
    Dim TableRow As MSHTML.HTMLTableRow
    Dim TableAnchor As MSHTML.HTMLAnchorElement
'    Dim CompanyToAdd As MSHTML.HTMLDocument
    Dim CompanyToAdd As MSHTML.HTMLTableCell
    Dim a, b, c As Long

    Url = "https://www.screener.in/login/"

    Set Sh = ActiveWorkbook.ActiveSheet

'           Debug.Print Sh.Type

    Set SW = New SHDocVw.ShellWindows
    Set IE = New SHDocVw.InternetExplorerMedium

    IE.Visible = True
    IE.Navigate Url

'    Wait till the Internet Explorer has finished loading
                Do While IE.ReadyState <> READYSTATE_COMPLETE
                Loop

'    Stores a reference to the HTML Document in that variable
                Set SUrl = IE.Document

'    Wait for document to load
                If SUrl.ReadyState = "complete" Then

                    SUrl.getElementsByTagName("input")(1).Value = "ivk2k17@gmail.com"

                    SUrl.getElementsByTagName("input")(2).Value = "screener12345"

                    Set Login = SUrl.getElementsByClassName("btn btn-primary").Item(0)

                        Login.Click

                    Application.Wait (Now + TimeValue("00:00:05"))

                    Set DUrl = IE.Document

                    DUrl.getElementsByClassName("form-control")(1).Value = "Price to earning < 15 AND Return on capital employed > 20%"

                    Application.Wait (Now + TimeValue("00:00:05"))

                    Set RunThisQuery = DUrl.getElementsByClassName("btn btn-primary").Item(2)

                        RunThisQuery.Click

                    Application.Wait (Now + TimeValue("00:00:05"))

                    Set RUrl = IE.Document

'                    Debug.Print RUrl.Location

                    Set TableRowCollection = RUrl.getElementsByTagName("table").Item(0).getElementsByTagName("tr")

'                        Debug.Print TableRowCollection.Length

                        For a = 1 To TableRowCollection.Length - 1

                    Set CompanyToAdd = RUrl.getElementsByTagName("table").Item(0).getElementsByTagName("tr").Item(a).getElementsByTagName("td").Item(1)

                        Next


                        If CompanyToAdd.hasAttributes Then

[B]Question:  I've tried using [B]addEventListener, but couldnt make it work!

'                            CompanyToAdd.addEventListener("onmouseenter", myFunction(), False)

'                                   Function myFunction()

'                                      If GetAsyncKeyState(VK_LBUTTON) Then

'                                        if LEFT mouse button is pressed
                                         Call OpenNewTab(CompanyToAdd.innerHTML, IE)


'                                      ElseIf GetAsyncKeyState(VK_RBUTTON) Then

'                                        if RIGHT mouse button is pressed
'                                        Call AddCompanyName(CompanyToAdd.innerHTML, IE)

'                                      End If

'                                   End Function

                       End If

                End If

 End Sub[/B][/B]