Google translate funzt nicht
28.01.2016 23:52:02
Tobias
Im Netz hab' ich ein Makro gefunden, das auf Google Translate zugreift. Leider funktioniert dies nur immer beim ersten Mal, danach wird immer derselbe übersetzte Begriff zurückgegeben. Im Beispiel unten kann ich also "dog" ändern, aber es wird immer noch "Hund" ausgegeben.
Woran liegt dies?
Danke vielmal für die Hilfe!
___________________________
Sub test()
If TranslateByGoogle("dog", "EN", "DE", Result, 5) Then
MsgBox Result
End If
End Sub
Public Function TranslateByGoogle(OrigineText As String, _
LangCodeFrom As String, _
LangCodeTo As String, _
TranslateText As String, _
TimeOutSeconds As Integer, _
Optional UniCodeID As Long, _
Optional ErrSilent As Boolean = False) As Boolean
'Copyright by Jean Pierre Allain
Dim ieOBJ As Object, WaitTime As Date
' Google Webseite
Const WebSite As String = "http://translate.google.com"
' Fehlerbehandlung
On Error GoTo ErrHandler
If Len(OrigineText) > 0 And Not LangCodeFrom = LangCodeTo Then
' IE Objekt (Instanz) erstellen
Set ieOBJ = CreateObject("InternetExplorer.Application")
' Webseite mit Parameter aufrufen
ieOBJ.Navigate WebSite & "/?sl=" & LangCodeFrom & _
"&tl=" & LangCodeTo & "#" & LangCodeTo & "|" & _
LangCodeFrom & "|" & OrigineText
' TimeOut festlegen
WaitTime = Now + TimeValue("00:00:" & TimeOutSeconds)
On Error Resume Next
Do
' Google-Ergebnis auslesen
TranslateText = ieOBJ.Document.getElementById("result_box").innerText
If Now() >= WaitTime Then Exit Do
Loop While TranslateText = ""
On Error GoTo ErrHandler
' Ergebnis auslesen (Überstzung)
If Len(TranslateText) > 0 And Not TranslateText = OrigineText Then
' Übersetzung ggf. in angegebene Landessprache konvertieren
If UniCodeID 0 Then
TranslateText = StrConv(TranslateText, vbUnicode, UniCodeID)
End If
TranslateByGoogle = True
End If
End If
ExitProc:
On Error Resume Next
' Objekte zerstören
ieOBJ.Quit
Set ieOBJ = Nothing
Exit Function
ErrHandler:
If Not ErrSilent Then
MsgBox Err.Description, vbCritical, Err.Number
End If
Resume ExitProc
End Function