vb@rchiv · Tipps & Tricks · Mit VB und Internet Explorer Google Übersetzer nutzen

Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE | VB-Versionen: VB6

19.01.11

Mit VB und Internet Explorer Google Übersetzer nutzen Eine Funktion, mit der sich die Übersetzungs-Funktion von Google per VB/VBA Funktionsaufruf nutzen lässt.
Autor: Jean Pierre Allain	Bewertung:	Views: 17.449
www.abiss.de	System: Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10	Beispielprojekt auf CD

Der Google Übersetzer Dienst wird immer besser. Daher die Idee diesen automatisiert mit VB/VBA zu nutzen.

Voraussetzungen sind: Verbindung zum Web und Internet Explorer.

' Übersetzung via Online Google Translate Funktion
Public Function TranslateByGoogle(OrigineText As String, _
  LangCodeFrom As String, _
  LangCodeTo As String, _
  TranslateText As String, _
  Optional UniCodeID As Long, _
  Optional TimeOutSeconds As Integer = 3, _
  Optional ErrSilent As Boolean = False) As Boolean
 
  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

Beispielaufruf:

Dim Result As String
 
' Sprach-Codes müssen als ISO-Ländercode übergeben werden
' Bsp.: Deutsch = DE
'       Englisch = EN
'       Französisch = FR
'       Polnisch = PL
'       usw.
 
If TranslateByGoogle("Das war ja einfach!", "DE", "EN", Result) Then
  MsgBox Result
End If