VBA function to get page's URL to extract gps coordinates - excel

I have a little problem, thanks for whatever help you might bring :)
my goal : i want to create a vba function that receives an address and returns the gps coordinates related to this address. To do so, i want to open my address in Openstreetmap (or Google Maps) in order to extract the page's URL which has the gps coordinated within it.
problem : my function only works way, it open the address in the navigator but it won't return the URL...
my code :
Option Explicit
Function AdresseToCoordonnesGPS(URL As String)
Dim navigateur As Object
Set navigateur = CreateObject("Shell.Application").ShellExecute("microsoft-edge:" & URL)
navigateur.Visible = True
Do While navigateur.busy And navigateur.ReadyState <> 4
DoEvents
Loop
pause (3)
Dim redirection As String
redirection = navigateur.locationUrl
redirection = Right(redirection, Len(redirection) - InStr(redirection, "#"))
redirection = Right(redirection, Len(redirection) - InStr(redirection, "/"))
AdresseToCoordonnesGPS = redirection
End Function
result : this function manages to open the link in the navigator (microsoft edge) it won't copy the page's URL, which i need in order to extract the GPS coordinates
here's what it return :

Related

Scraping web [VBA] xmlhttprequest

I am stuck with this. I am trying to learn how to use xmlhttprequest with VBA. My intention is to access the following url: "https://micuil.net/".
Once there, I can send values to the following fields, as seen in the image:
image1
After pressing the button, the page displays the following information with the data I want to extract:
image2 (return value)
I am able to complete what you see in image 1 by code, but I don't know how to get the result (image 2). Any help please?
Function CuitEstimado2(sDni As Variant, sSexo As String) As String
Set oDoc = New HTMLDocument
Set oHTTP = New XMLHTTP60
sSexo = IIf(sSexo = "f", "Mujeres", "Varones")
sUrl = "https://micuil.net/"
oHTTP.Open "GET", sUrl, False
oHTTP.send
sRespuesta = oHTTP.responseText
oDoc.body.innerHTML = sRespuesta
oDoc.getElementById("dni").Value = sDni
oDoc.getElementsByName("sexo")(0).setAttribute("checked") = True
oDoc.getElementById("btn").parentElement.Click
End Function
Without having done heavy research for the specific website you are using, it may still be possible that the result you are looking for can be found within the response text (assuming I am understanding your dilemma properly).
First, it is recommended to perform a loop through the innerHTML of each element contained in the HTMLDoc. During your loop, use the InStr function to locate the result code as a string. It is a good idea to store each element that contains that result code into a collection for easy access after the loop.
It does get a bit more complicated from here, because the innerHTML of the corresponding elements may differ when pasting them into Notepad vs. trying to utilize in the VBE. However, if you can identify any unique JS (or other language) characters that will consistently indicate the location of the result code for each request, you may be able to use the Mid function to return the desired result into a string variable.

Web scraping DEEPL.com using VBA Excel and Selenium

i'm trying to code a function to translate sentences in Excel using DEEPL.com
My approach is using Selenium to scrape the web using Chrome (as IExplore is not supported by the web).
Public Function deepL(txt As String, inputLang As String, outputLang As String)
Dim url As String
Dim driver As New WebDriver
url = "https://www.deepl.com/translator#" & inputLang & "/" & outputLang & "/" & txt
driver.Start "Chrome"
driver.Timeouts.ImplicitWait = 5000
driver.Get url
deepL = driver.FindElementById("target-dummydiv").Text
driver.Close
End Function
----
Sub translating()
'test for word "probando" from "es" to "en"
'url: https://www.deepl.com/translator#es/en/probando
'it should return: "testing"
MsgBox (deepL("probando", "es", "en"))
End Sub
The problem comes when loading the web, so the div containing the translation is empty on load, and the GET instruction returns an empty text.
But after 1 second, the page refreshes with the correct result:
<div id="target-dummydiv" aria-hidden="true" class="lmt__textarea lmt__textarea_dummydiv" lang="en-US">testing</div>
I tried adding an implicit wait of 5 seconds in order to give time to the webpage to load, but the result is the same.
What am I doing wrong?
EDIT: I found that the div with the translation has visibility: hidden. If I show the visibility, the results are correct, but don't know how to get that in my code
OK, I found a solution:
just select the textarea where the translation is located and get the translation with .attribute("value") instead of .text
deepL = driver.FindElementByCss("textarea.lmt__textarea.lmt__target_textarea.lmt__textarea_base_style").Attribute("value")

Click Java Button in URL with Excel VBA

Trying to achive downloading table from company website. I can download first page. However, cannot jump to second page.
HTML CODE for Page Number
1
HTML CODE
[![HTML CODE FOR TABLE][1]][1]
page numbers are inside table and increasing one by one. at the first time when page one is active link href is not visible and shows as
<span>1</span>
I use below code to click page however I cannot succeded.
Set doc = ie.document
i = 0
For Each link In doc.Links
'doing downloading stuff here
i = i + 1
link.innerText = "javascript:__doPostBack('ctl00$View$gv','Page$" & i
link.Click
Next
When I check the page also there is a javascript function.
Javasript CODE
//<![CDATA[
var theForm = document.forms['aspnetForm'];
if (!theForm) {
theForm = document.aspnetForm;
}
function __doPostBack(eventTarget, eventArgument) {
if (!theForm.onsubmit || (theForm.onsubmit() != false)) {
theForm.__EVENTTARGET.value = eventTarget;
theForm.__EVENTARGUMENT.value = eventArgument;
theForm.submit();
}
}
//]]>
after first page downloaded, macro click irrelevant page links even never click same page for each time.
Extra Question
also is there any way to get href values instead of innertext on below code
User Name
Thanks
Open any page by parameter of the url:
Look if you can open any page directly by a parameter of the url for the page number like this:
https://yourUrl.com?page=2
Then the walk through all pages is very easy. The only thing you must check at first is the number of the pages or a html code that only is in the page code when you try to open a page that is not available.
How to get href
You can't click innertext. That is only a string. You ask for a way to get the href and that is the right thought. If you want get the href of the first a-tag you can use this:
'Part of your code to open the page
'...
Dim nodeFirstLink as Object
Set nodeFirstLink = doc.getElementsByTagName("a")(0)
Debug.Print nodeFirstLink.href
'More of your code
'...
Here is an example how to change the href
But I don't know if this works also with JS links:
Sub ChangeHref()
Dim htmlDoc As Object
Dim nodeFirstLink As Object
'Set a short HTML Document for this example
Set htmlDoc = CreateObject("HtmlFile")
htmlDoc.body.innerHTML = "<a href='https://amazon.com'>Amazon</a>"
Set nodeFirstLink = htmlDoc.getElementsByTagName("a")(0) 'Get the first Link
Debug.Print nodeFirstLink.outerhtml 'The HTML of the first link in the html document
Debug.Print nodeFirstLink.href 'Only the href of the first link in the html document
nodeFirstLink.href = "https://ebay.com" 'Changing the href in the first link
Debug.Print nodeFirstLink.outerhtml 'The innertext is still Amazon
Debug.Print nodeFirstLink.href 'The href is the new one
End Sub

User Defined Function in Excel with Internet Explorer giving error because of time of fetch

I am trying to create a user defined function in Excel VBA which will go to an e-commerce website (say https://www.woolworths.com) and fetch the product title of a particular product. I have created the complete code and if I debug it, it's working fine and giving me the data. The code I have created is as below:
Function function1() As Integer
Dim browser As Object
Dim htmlDoc As New htmlDocument
Dim productName As String
url = "https://www.woolworths.com.au/shop/productdetails/781394/red-rock-deli-share-pack-honey-soy-chicken"
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
Application.Wait (Now + TimeSerial(0, 0, 4))
Set htmlDoc = browser.document
'Get Product Name
productName = htmlDoc.getElementsByClassName("shelfProductTile-title heading3")(0).innerText
function1 = 5
End Function
Note:
Even though I said that I want product name, I have intentionally given the output as "5" just for testing purposes.
For the code to work, I will just change the function output as String as change "5" to productName
The problem is that when I try to use this function from the Excel file, it is giving me "#Value" error (attaching a snapshot in the end). But if I hide the line "productName = htmlDoc.getElementsByClassName("shelfProductTile-title heading3")(0).innerText", then it is working fine.
I guess this is something related to the speed of function working. Since the ie window opening takes time, the function might get expired or something. Please help me out here.
Snapshot of error:

How to get actual Google search URL in Excel + How to extract website adress out of cell

I am stuck at the current situation. I have a couple of hundreds business names of which i have to search for the website adress.
Question 1:
What i have at the moment is an google search link in excel with the =hyperlink(etc,etc), with the business name and adress.
For example: http://www.google.com/search?hl=en&q=Airbus+12th street 12 +New York+&btnG=Google+Search"
But what i actually need is the url in the internet browser, which i get when i click on the excel hyperlink:
If i click on above link, this is the actual link i need: https://www.google.nl/search?hl=en&q=Airbus+12th+street+%C2%A012%C2%A0+New+York+&btnG=Google+Search&gws_rd=cr&dcr=0&ei=o3nLWqbjN87PwAKY54_oCg
My question, is it possible to do this automaticly and get the actual link in excel ?
Question 2:
In excel i have a whole cell full of data. In this data, there is 1 url. For example, cell contains: ''ujeri sfifs93 sfisdsu fiweu2 732732 fjsdfue http:www.iwantthislink.comm sdfsdf shsdf sju32u3un''
is is possible to automaticly extract a word from this cell, beginning with http://www. ? And do this for every cell i want ?
Thanks in advance!
Example for your first question. You could do this by navigating to the url you've got in your workbook, wait for the redirect then return the redirected url
Public Sub GetRedirectedLink()
Dim IE As Object
Dim InitialUrl As String, RedirectUrl As String
Set IE = CreateObject("InternetExplorer.Application")
InitialUrl = "http://www.google.com/search?hl=en&q=Airbus+12th%20street%2012+New%20York+&btnG=Google+Search"
With IE
.Visible = False
' Navigate to url
.navigate InitialUrl
' Wait while page loads
Do While .Busy
Application.Wait DateAdd("s", 1, Now)
Loop
' return Redirected URL
RedirectUrl = .LocationURL
End With
MsgBox RedirectUrl
End Sub
For your second question you could use regular expressions to return the domain name (if that is the part that you want)

Resources