Using XMLHTTP instead of pilotting Internet Explorer

user_7657180 0
Viewed 129

I have the following working code that uses Internet Explorer .. 

Sub Translate()
Dim ie      As Object
Dim html    As Variant
Dim lngto   As String
Dim i       As Long

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = 0
lngto = "en"

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(Cells(i, 1)) Then
        ie.navigate "https://translate.google.com/#ar/" & lngto & "/" & Range("A" & i).Value

        Do Until ie.readyState = 4: DoEvents: Loop

        Application.Wait (Now + TimeValue("00:00:02"))
        Range("B" & i).Value = ie.document.querySelector(".translation").innerText
    End If
Next i

ie.Quit
Set ie = Nothing

MsgBox "Done...", 64
End Sub

How can I use XMLHTTP to get the results faster ..? Or Google doesn't more support using such approaches Thanks advanced for help

** Louis solution was perfect and it works only for the first time but after a while I got this result

<!DOCTYPE html PUBLIC -//W3C//DTD HTML 4.01 Transitional//EN>
<html>
<head><meta http-equiv=content-type content=text/html; charset=utf-8><meta name=viewport content=initial-scale=1><title>https://translate.google.com/translate_a/t?client=s&amp;text=%D8%A8%D8%B3%D9%85%20%D8%A7%D9%84%D9%84%D9%87&amp;hl=en&amp;sl=ar&amp;tl=en&amp;multires=1&amp;pc=0&amp;rom=1&amp;sc=1</title></head>
<body style=font-family: arial, sans-serif; background-color: #fff; color: #000; padding:20px; font-size:18px; onload=e=document.getElementById('captcha');if(e){e.focus();}>
<div style=max-width:400px;>
<hr noshade size=1 style=color:#ccc; background-color:#ccc;><br>
<div style=font-size:13px;>
Our systems have detected unusual traffic from your computer network.  Please try your request again later.  <a href=# onclick=document.getElementById('infoDiv0').style.display='block';>Why did this happen?</a><br><br>
<div id=infoDiv0 style=display:none; background-color:#eee; padding:10px; margin:0 0 15px 0; line-height:1.4em;>
This page appears when Google automatically detects requests coming from your computer network which appear to be in violation of the <a href=//www.google.com/policies/terms/>Terms of Service</a>. The block will expire shortly after those requests stop.<br><br>This traffic may have been sent by malicious software, a browser plug-in, or a script that sends automated requests.  If you share your network connection, ask your administrator for help &mdash; a different computer using the same IP address may be responsible.  <a href=//support.google.com/websearch/answer/86640>Learn more</a><br><br>Sometimes you may see this page if you are using advanced terms that robots are known to use, or sending requests very quickly.
</div><br>

IP address: 156.212.29.90<br>Time: 2019-10-12T08:56:47Z<br>URL: https://translate.google.com/translate_a/t?client=s&amp;text=%D8%A8%D8%B3%D9%85%20%D8%A7%D9%84%D9%84%D9%87&amp;hl=en&amp;sl=ar&amp;tl=en&amp;multires=1&amp;pc=0&amp;rom=1&amp;sc=1<br>
</div>
</div>
</body>
</html>

vba excel
1 Answers

Use MSXML2.XMLHTTP

I was in the same position and decided to switch to XMLHTTPRequest, which is much faster and doesn't need to loop until data is received (using Async = False). You can use POST method and GET method.

POST Method 

Function sendXmlHttpRequest(URL As String, FormData As String, Boundary As String) As String
    Dim XMLHTTP As New MSXML2.XMLHTTP

    'Send the form data To URL As POST request
    Dim bFormData() As Byte
    ReDim bFormData(Len(FormData) - 1)
    bFormData = StrConv(FormData, vbFromUnicode)

    XMLHTTP.Open "POST", URL, False
    XMLHTTP.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + Boundary + vbCrLf
    XMLHTTP.send bFormData

    'MsgBox XMLHTTP.responseText 'if you need to show the response
    sendXmlHttpRequest = XMLHTTP.responseText
End Function

Where the parameters mean:

  • URL: The URL to which send the request.
  • FormData: The file to send in my case, but can be any data.
  • Boundary of fields: a String not contained in the source file to send.

GET Method 

Function sendXmlHttpRequest(URL As String) As String
    Dim XMLHTTP As New MSXML2.XMLHTTP

    XMLHTTP.Open "GET", URL, False
    XMLHTTP.send

    'MsgBox XMLHTTP.responseText 'if you need to show the response
    sendXmlHttpRequest = XMLHTTP.responseText
End Function

Sub Test()
     sendXmlHttpRequest "http://www.google.it"
End Sub

Back to your solution

The code was not working because google translator was sending an error page where they say that something was wrong with the URL.
After searching for a while, I found a URL format that work when sent their server. Here's the complete working code:

Sub Translate()
    Dim html    As Variant
    Dim strText As String
    Dim strURL  As String
    Dim lngFrom As String
    Dim lngTo   As String
    Dim i       As Long

    lngFrom = "ar"
    lngTo = "en"

    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Not IsEmpty(Cells(i, 1)) Then
            'Encoding to URL, in case there're special characters in the string
            strText = Application.EncodeURL(Range("A" & i).Value)

            'Preparing the url
            strURL = "https://translate.google.com/translate_a/t?client=s&text={S}&hl=en&sl={F}&tl={T}&multires=1&pc=0&rom=1&sc=1"

            strURL = Replace$(strURL, "{S}", strText) 'Inject Text to decode
            strURL = Replace$(strURL, "{F}", lngFrom) 'Inject language from
            strURL = Replace$(strURL, "{T}", lngTo)   'Inject language to

            'Send request and remove quotes from result.
            Range("B" & i).Value = removeQuotes(sendGETRequest(strURL))
        End If
    Next i

    MsgBox "Done...", vbInformation
End Sub

Function sendGETRequest(URL As String) As String
    Dim XMLHTTP As New MSXML2.XMLHTTP

    XMLHTTP.Open "GET", URL, False
    XMLHTTP.send ("")

    'MsgBox XMLHTTP.responseText
    sendGETRequest = XMLHTTP.responseText
End Function

'To remove quotes returned from Google translator string
Function removeQuotes(text As String) As String
    removeQuotes = Replace(text, """", "")
End Function

Note: This is tested and working. You'll also need to add the reference to Microsoft XML, v3.0

I hope this helps.

user_62482190
Related