Ace_McCloud
New Member
- Joined
- Apr 4, 2017
- Messages
- 2
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
Note: I've already posted the same question on stackoverflow. Here's the link:
https://stackoverflow.com/questions/...24324_47968379
Code:
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]