-
Dec 16th, 2020, 11:47 AM
#1
Thread Starter
Junior Member
i cant load result google translate
I give the input manually to Google Translator, but unfortunately I did everything I could not get the output output from Google Translator
Please help Thanks
HTML Code:
<span jsaction="click:qtZ4nf,GFf3ac,tMZCfe; contextmenu:Nqw7Te,QP7LD; mouseout:Nqw7Te; mouseover:qtZ4nf,c2aHje" jsname="W297wb">[B][COLOR="#0000CD"]Hi, I can not load the Google result[/COLOR][/B]</span>
-
Dec 24th, 2020, 09:58 AM
#2
Thread Starter
Junior Member
Re: i cant load result google translate
Hello friends, can anyone help?
-
Dec 24th, 2020, 10:10 AM
#3
Re: i cant load result google translate
Look into the Google Translate API. it costs money.
You can't just automate scraping. Google will defeat your attempts.
-
Jan 2nd, 2021, 05:54 PM
#4
Thread Starter
Junior Member
Re: i cant load result google translate
Originally Posted by dilettante
Look into the Google Translate API. it costs money.
You can't just automate scraping. Google will defeat your attempts.
Google Translate API?
Do you have a link for this?
No matter how hard I searched, I did not find anything
To translate a few words, I need the program to connect to Google Translator
-
Jan 3rd, 2021, 04:30 AM
#5
Re: i cant load result google translate
There are a lot of results when searching for “google translate api”
If you add vba or vb6 to the query then you can even find howto’s
https://stackoverflow.com/questions/...icrosoft-excel
-
Jan 9th, 2021, 11:05 AM
#6
New Member
Re: i cant load result google translate
Translation using Google or Microsoft.
Code:
Option Explicit
Private Const HDR_CL As String = "Content-Length"
Private Const HDR_CT As String = "Content-Type"
Private Const HDR_CT_JSON As String = "application/json"
Private masTexts() As String
Private mbMS As Boolean
Private mbTranslated As Boolean
Private WithEvents moWinHttpRequest As WinHttp.WinHttpRequest
Private Function PrepareTexts() As String
Dim lIdx As Long
Dim sFind As String
Dim sReplace As String
Dim sDelimiter As String
If mbMS Then
sDelimiter = """},{""Text"":"""
Else
sDelimiter = """,""q"":"""
End If
sFind = Chr$(&H22)
sReplace = """
For lIdx = LBound(masTexts) To UBound(masTexts)
If InStrB(1, masTexts(lIdx), sFind) <> 0 Then
masTexts(lIdx) = Replace(masTexts(lIdx), sFind, sReplace)
End If
Next
PrepareTexts = Join(masTexts, sDelimiter)
End Function
Private Function Translate(ByRef pvTexts As Variant, Optional ByVal pbMS As Boolean) As Boolean
Dim sRequest As String
Dim sURL As String
On Error GoTo ERROR_CATCH
mbMS = pbMS
If mbMS Then
sURL = "https://api.cognitive.microsofttranslator.com/translate?api-version=3.0&from=<ORIGINAL_LANGUAGE>&to=<TRANSLATED_LANGUAGE>"
sRequest = "[{""Text"":""" & PrepareTexts() & """}]"
Else
sURL = "https://translation.googleapis.com/language/translate/v2?key=<YOUR GOOGLE API KEY>"
sRequest = "{""q"":""" & PrepareTexts() & """,""source"":""<ORIGINAL_LANGUAGE>"",""target"":""<TRANSLATED_LANGUAGE>"",""format"":""text""}"
End If
Set moWinHttpRequest = New WinHttp.WinHttpRequest
On Error Resume Next
With moWinHttpRequest
.SetTimeouts 30000&, 60000, 60000, 60000
.Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_TLS1 Or SecureProtocol_TLS1_1 Or SecureProtocol_TLS1_2
If Err.Number Then
Err.Clear: .Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_TLS1 Or SecureProtocol_TLS1_1
If Err.Number Then
Err.Clear: .Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_TLS1
If Err.Number Then Err.Clear
End If
End If
On Error GoTo ERROR_CATCH
.Open "POST", sURL, True
.SetRequestHeader HDR_CT, HDR_CT_JSON
.SetRequestHeader HDR_CL, Len(sRequest)
If mbMS Then
.SetRequestHeader "Ocp-Apim-Subscription-Key", "<YOUR MS API KEY>"
End If
.Send (sRequest)
End With
Translate = True
Exit Function
ERROR_CATCH:
With Err
MsgBox .Number & "-" & .Description, vbExclamation
.Clear
End With
End Function
Private Sub moWinHttpRequest_OnError(ByVal ErrorNumber As Long, ByVal ErrorDescription As String)
MsgBox ErrorNumber & "-" & ErrorDescription, vbExclamation
End Sub
Private Sub moWinHttpRequest_OnResponseFinished()
Dim lIdx As Long
Dim oMatch As VBScript_RegExp_55.Match
Dim oRegExp As VBScript_RegExp_55.RegExp
Dim sFind As String
Dim sReplace As String
Dim sResponse As String
Dim vSubMatch As Variant
On Error GoTo ERROR_CATCH
sFind = """
sReplace = Chr$(&H22)
With moWinHttpRequest
If .Status = 200 Then
sResponse = .ResponseText
Debug.Print sResponse
Set oRegExp = New VBScript_RegExp_55.RegExp
With oRegExp
.Global = True
.IgnoreCase = False
.MultiLine = False
If mbMS Then
.Pattern = """text"":""([^""]*)"
Else
.Pattern = """translatedText"": ""([^""]*)"
End If
For Each oMatch In .Execute(sResponse)
masTexts(lIdx) = oMatch.SubMatches(0)
If InStrB(1, masTexts(lIdx), sFind) <> 0 Then
masTexts(lIdx) = Replace(masTexts(lIdx), sFind, sReplace)
End If
lIdx = lIdx + 1
Next
.Pattern = "(\\u[0-9a-f]{4})"
For lIdx = 0 To UBound(masTexts)
For Each oMatch In .Execute(masTexts(lIdx))
For Each vSubMatch In oMatch.SubMatches
sFind = vSubMatch
sReplace = ChrW$(Replace(sFind, "\u", "&H"))
masTexts(lIdx) = Replace(masTexts(lIdx), sFind, sReplace)
Next
Next
Next
End With
Set oRegExp = Nothing
mbTranslated = True
Debug.Print Join(masTexts, vbNewLine)
Else
mbTranslated = False
MsgBox "Status: " & .Status & "-" & .StatusText & vbNewLine & _
"Response: " & sResponse, vbExclamation
End If
End With
Exit Sub
ERROR_CATCH:
With Err
MsgBox .Number & "-" & .Description, vbExclamation
.Clear
End With
Set oMatch = Nothing
Set oRegExp = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set moWinHttpRequest = Nothing
End Sub
Last edited by zeilo; Jan 9th, 2021 at 11:15 AM.
-
Jan 9th, 2021, 11:31 AM
#7
Re: i cant load result google translate
Personally, I use DeepL, better translation, in several languages
Here is my very simple code
Code:
Option Explicit
Dim objIE As Object
Sub testTranslate()
Debug.Print Translate_DeepL("en", "fr", "winter is coming")
End Sub
Public Function Translate_DeepL(sFrom As String, sTo As String, sText As String) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 15/1/2018
' * Time : 12:29
' * Module Name :
' * Module Filename :
' * Procedure Name :
' * Purpose :
' * Parameters :
' * sFrom As String
' * sTo As String
' * sText As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim timeOut As Date
Const CLASSNAME As String = "lmt__textarea lmt__target_textarea lmt__textarea_base_style"
On Error Resume Next
If objIE Is Nothing Then Set objIE = CreateObject("InternetExplorer.Application")
objIE.Document.getElementsByClassName(CLASSNAME)(0).innerText = vbNullString
objIE.Navigate "https://www.deepl.com/translator#" & sFrom & "/" & sTo & "/" & Replace(sText, " ", "%20")
timeOut = Now + TimeValue("00:00:05")
Do
Translate_DeepL = objIE.Document.getElementsByClassName(CLASSNAME)(0).innerText
If Now >= timeOut Then Exit Do
Loop While Translate_DeepL = vbNullString
End Function
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|