Hitro Macors

[Anup24]

Button 1,2

RPC Link

Company Link

Company Website

Employee Size

Industry Type

Company Name

Job Title

module 1 ::

Public Function Get_CompanyLink_From_RPC_Link(acell As Range)
sUrl = acell.Value
IE.Navigate sUrl
'Wait until IE is done loading page
Do While IE.READYSTATE <> READYSTATE_COMPLETE
DoEvents
Loop
'show text of HTML document returned
Set HTML = IE.Document
''RPC Title
'sStart = InStr(html.DocumentElement.innerHTML, "<Title>")
'If sStart < 1 Then
'acell.Offset(0, 1).Value = "Error"
'GoTo RPCTitleJump
'End If
'sEnd = InStr(sStart, html.DocumentElement.innerHTML, "</title>")
'RPCTitle = Mid(html.DocumentElement.innerHTML, sStart + 7, sEnd - sStart - 7)
'acell.Offset(0, 1).Value = RPCTitle
'RPCTitleJump:
'Company Link
sStart = InStr(HTML.DocumentElement.innerHTML, "background-experience-container")
If sStart < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CLinkJump
End If
sEnd = InStr(sStart, HTML.DocumentElement.innerHTML, "</script></div></div>")
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CLinkJump
End If
BodyToUse = Mid(HTML.DocumentElement.innerHTML, sStart, sEnd - sStart)
'acell.Offset(0, 5).Value = BodyToUse
sStart = InStr(BodyToUse, "/company/")
If sStart < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CLinkJump
End If
sEnd = InStr(sStart, BodyToUse, "?trk=prof-exp-company-name")
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CLinkJump
End If
CompanyLink = Mid(BodyToUse, sStart, sEnd - sStart)
acell.Offset(0, 1).Value = "linkedin.com" & CompanyLink
'sStart = InStr(sEnd, BodyToUse, CompanyLink & "?trk=prof-exp-company-name")
'If sStart < 1 Then
'acell.Offset(0, 5).Value = "Error"
'GoTo CLinkJump
'End If
'sStart = InStr(sStart, BodyToUse, ">")
'If sStart < 1 Then
'acell.Offset(0, 5).Value = "Error"
'GoTo CLinkJump
'End If
'sEnd = InStr(sStart, BodyToUse, "</a>")
'If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
'acell.Offset(0, 5).Value = "Error"
'GoTo CLinkJump
'End If
'CompanyName = Mid(BodyToUse, sStart + 1, sEnd - sStart - 1)
'acell.Offset(0, 5) = CompanyName
CLinkJump:
sStart = InStr(BodyToUse, "https://www.linkedin.com/title/")
If sStart < 1 Then
JobTitle = "Error"
GoTo JTJump
End If
sStart = InStr(sStart, BodyToUse, ">")
sEnd = InStr(sStart, BodyToUse, "</a>")
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 6).Value = "Error"
GoTo JTJump
End If
JobTitle = Mid(BodyToUse, sStart + 1, sEnd - sStart - 1)
acell.Offset(0, 6) = JobTitle
JTJump:
End Function

Public Function Get_Company_Details(acell As Range)
'Sub Test()
sUrl = acell.Value
'sUrl = "linkedin.com/company/8221"
IE.Navigate sUrl
'Wait until IE is done loading page
Do While IE.READYSTATE <> READYSTATE_COMPLETE
DoEvents
Loop
'show text of HTML document returned
Set HTML = IE.Document
'Cname
sStart = InStr(HTML.DocumentElement.innerHTML, "<title>")
If sStart < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CompanyNameJump
End If
sEnd = InStr(sStart, HTML.DocumentElement.innerHTML, "Overview")
sEnd = sEnd - 2
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 4).Value = "Error"
GoTo CompanyNameJump
End If
CompanyName = Mid(HTML.DocumentElement.innerHTML, sStart + 7, sEnd - sStart - 7)
acell.Offset(0, 4).Value = CompanyName
CompanyNameJump:
'CWebsite
sStart = InStr(HTML.DocumentElement.innerHTML, "basic-info-about")
If sStart < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CWebsiteJump
End If
sEnd = InStr(sStart, HTML.DocumentElement.innerHTML, "<h4>Company Size</h4>")
sEnd = sEnd + 50
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CWebsiteJump
End If
BodyToUse = Mid(HTML.DocumentElement.innerHTML, sStart, sEnd - sStart)
sStart = InStr(BodyToUse, "<h4>Website</h4>")
If sStart < 1 Then
acell.Offset(0, 1).Value = "Error"
GoTo CWebsiteJump
End If
sStart = InStr(sStart, BodyToUse, "<a")
sStart = InStr(sStart, BodyToUse, ">")
sEnd = InStr(sStart, BodyToUse, "</a>")
CWebsite = Mid(BodyToUse, sStart + 1, sEnd - sStart - 1)
acell.Offset(0, 1).Value = CWebsite
CWebsiteJump:
'Company_Size
sStart = InStr(BodyToUse, "<h4>Company Size</h4>")
If sStart < 1 Then
acell.Offset(0, 2).Value = "Error"
GoTo CSizeJump
End If
sStart = InStr(sStart, BodyToUse, "<p>")
If sStart < 1 Then
acell.Offset(0, 2).Value = "Error"
GoTo CSizeJump
End If
sEnd = InStr(sStart, BodyToUse, "</p>")
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 2).Value = "Error"
GoTo CSizeJump
End If
CSize = Mid(BodyToUse, sStart + 3, sEnd - sStart - 3)
acell.Offset(0, 2).Value = CSize
CSizeJump:
'Company_Industry
sStart = InStr(BodyToUse, "<h4>Industry</h4>")
If sStart < 1 Then
acell.Offset(0, 3).Value = "Error"
GoTo CIndustryJump
End If
sStart = InStr(sStart, BodyToUse, "<p>")
If sStart < 1 Then
acell.Offset(0, 3).Value = "Error"
GoTo CIndustryJump
End If
sEnd = InStr(sStart, BodyToUse, "</p>")
If sEnd < sStart Or sStart < 1 Or sEnd < 1 Then
acell.Offset(0, 3).Value = "Error"
GoTo CIndustryJump
End If
CIndustry = Mid(BodyToUse, sStart + 3, sEnd - sStart - 3)
'MsgBox CSize
acell.Offset(0, 3).Value = CIndustry
CIndustryJump:
End Function

module 2::

'Sub Test1()
'to refer to the running copy of Internet Explorer
Public IE As Object
'to refer to the HTML document returned
'Public HTML As HTMLDocument
'open Internet Explorer in memory, and go to website
'Set ie = New InternetExplorer
Public sUrl As String 'Source Url
Public sStart As Long
Public sEnd As Long
Public SubStart As Long
Public BodyToUse As String
'Dim Cname As String
Public JobTitle As String
Public CompanyLink As String
Public CompanyName As String
Public RPCTitle As String
Public CSize As String
Public CWebsite As String
Public CIndustry As String
'to refer to the running copy of Internet Explorer
'READYSTATE used to recognize webpage loading status status
Enum READYSTATE
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4
End Enum
Sub Fetch_From_RPC_Link()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
Dim acell As Range
'Dim Test As Var
For Each acell In Selection
Call Get_CompanyLink_From_RPC_Link(acell)
Call Get_Company_Details(acell.Offset(0, 1))
'Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255"
' Shell ("RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1")
' Shell ("RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2")
' Shell ("RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 ")
Next
End Sub

Sub Fetch_From_Company_Link()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
Dim acell As Range
'Dim Test As Var
For Each acell In Selection
Call Get_Company_Details(acell)
'Call Get_Company_Details(acell.Offset(0, 1))
'Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255"
' Shell ("RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1")
' Shell ("RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2")
' Shell ("RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 ")
Next
End Sub

module 3::

Sub Button1_Click()
Call Fetch_From_RPC_Link
End Sub
Sub Button2_Click()
Call Fetch_From_Company_Link
End Sub

[Leith Ross]

Hello Anup24,

What was your question?

[Aussiebear]

It appears that the above code has the potential to strip information from a particular website. We have been through this sort of issue before and have a policy of not supporting any requests to assist with breeching other company policies, such as Linkedin. Unless I can be convinced otherwise this thread will remain closed.

[Aussiebear]

It appears that the above code has the potential to strip information from a particular website. We have been through this sort of issue before and have a policy of not supporting any requests to assist with breeching other company policies, such as Linkedin. Unless I can be convinced otherwise this thread will remain closed. I also note that Anup24 has been advised of this and yet continues to try to request assistance in this matter.