vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE   |   VB-Versionen: VB619.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 AllainBewertung:     [ Jetzt bewerten ]Views:  18.159 
www.abiss.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 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

Dieser Tipp wurde bereits 18.159 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (3 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel