.titleBar { margin-bottom: 5px!important; }

Fritzboxdingsbums, Rückwärtssuche über www.telsearch.ch für Outlook

Dieses Thema im Forum "andere Software" wurde erstellt von tzhscgu3, 10 Feb. 2007.

  1. tzhscgu3

    tzhscgu3 Neuer User

    Registriert seit:
    20 Okt. 2006
    Beiträge:
    32
    Zustimmungen:
    0
    Punkte für Erfolge:
    0
    Hallo FBF Gemeinde

    Ich habe mir Fritzboxdingsbums zugelegt und möchte die Rückwärtssuche umbiegen, so dass der Name auf www.telsearch.ch gesucht wird. Ich habe diese Funktion schon auf meiner Asterisk und weiss wie es funktioniert, jedoch kenne ich mich zu wenig mit Outlook Makros aus.

    Besten Dank.

    Guido
     
  2. tzhscgu3

    tzhscgu3 Neuer User

    Registriert seit:
    20 Okt. 2006
    Beiträge:
    32
    Zustimmungen:
    0
    Punkte für Erfolge:
    0
    Ich nehme an, es hat mir niemand geantwortet, weil mein Vorhaben so leicht ist, dass ich inzwischen selbst rausgefunden habe, wie es funktioniert.

    Besten Dank.
     
  3. Kruemelino

    Kruemelino Aktives Mitglied

    Registriert seit:
    21 Jan. 2006
    Beiträge:
    1,045
    Zustimmungen:
    1
    Punkte für Erfolge:
    38
    Beruf:
    Dipl.-Ing.
    Ort:
    Radeburg
    Ich habe dir nicht geantwortet, weil ich es erst jetzt gelesen habe. Wenn du willst, kannst du mir ja mal deine neue Änderungen schicken.

    Gruß Kruemelino
     
  4. gonzzo

    gonzzo Neuer User

    Registriert seit:
    28 März 2007
    Beiträge:
    51
    Zustimmungen:
    0
    Punkte für Erfolge:
    0
    ja, das würde mich auch interessieren. lösung bitte posten..
    danke
     
  5. tzhscgu3

    tzhscgu3 Neuer User

    Registriert seit:
    20 Okt. 2006
    Beiträge:
    32
    Zustimmungen:
    0
    Punkte für Erfolge:
    0
    Die RWSuche habe ich mit folgenden Zeilen ergänzt:

    Code:
    Function RWStelsearch(ByRef TelNr As String, ByRef vCard As String) As Boolean
        ' führt die Rückwärtssuche über 'www.telsearch.ch' durch
        ' Parameter:  TelNr (String):  Telefonnummer des zu Suchenden
        '             vCard (String):  vCard falls was gefunden wurde (nur Rückgabewert)
        ' Rückgabewert (Boolean):      'true' wenn was gefunden wurde
    
        Dim myurl                            As String             ' URL von telsearch
        Dim temp                             As String             ' Hilfsstring
        Dim tempTelNr                        As String             ' Hilfsstring für TelNr
        Dim alleTelNr                        As String             ' alle TelNr der gefundenen vCard
        Dim http                             As New WinHttpRequest ' WinHttp-Objekt
        Dim htmltelsearch                        As String             ' Inhalt der Webseite
        Dim Vorwahl                          As String             ' Vorwahl von TelNr
        Dim pos1 As Long, pos2 As Long, pos3 As Long               ' Positionen in 'htmltelsearch'
        Dim i                                As Long               ' Zählvariable
        
        'Eindeutige Suchwörter, nach denen die gesuchten Daten anfangen (ohne ", chr(09), chr(10) und chr(13)):
        Const SWVisitenkarte1 As String = "<a href=/vCard/"
        Const SWVisitenkarte2 As String = "title"
        
        ' TelNr sichern, da sie unter Umständen verändert wird
        tempTelNr = nurZiffern(TelNr, "0041")
        ' Suche wird unter Umständen mehrfach durchgeführt, da auch Firmennummern gefunden werden sollen.
        ' Dafür werden die letzten beiden Ziffern von TelNr durch '0' ersetzt und noch einmal gesucht.
        ' Schleife wird maximall drei mal durchlaufen
        i = 0
        Do
            ' Webseite für Rückwärtssuche aufrufen und herunterladen
            myurl = "http://tel.search.ch/result.html?name=&misc=&strasse=&ort=&kanton=&tel=" & tempTelNr
            http.Open "GET", myurl, True
            On Error GoTo catch
            http.send
            If http.WaitForResponse(10) Then
                htmltelsearch = Replace(http.ResponseText, Chr(34), "", , , vbTextCompare) '" enfernen
            Else
                htmltelsearch = ""
            End If
            On Error GoTo 0
            ' Link zum Herunterladen der vCard suchen
            pos1 = InStr(1, htmltelsearch, SWVisitenkarte1, vbTextCompare)
            If Not pos1 = 0 Then
                pos2 = InStr(pos1, htmltelsearch, SWVisitenkarte2, vbTextCompare)
                If Not pos1 = Len(SWVisitenkarte2) And Not pos2 = 0 Then
                    ' vCard herunterladen
                    myurl = "http://tel.search.ch/" & Mid(htmltelsearch, pos1 + 9, pos2 - pos1 - 10)
                    myurl = Replace(myurl, "html", "vcf")
                    http.Open "GET", myurl, True
                    On Error GoTo catch
                    http.send
                    If http.WaitForResponse(10) Then vCard = http.ResponseText Else vCard = ""
                    On Error GoTo 0
                    ' formatierte Telefonnummer aus vCard entnehmen
                    alleTelNr = ReadFromVCard(vCard, "TEL", "")
                    Do
                        pos1 = InStr(1, alleTelNr, ";", vbTextCompare)
                        If pos1 = 0 Then temp = alleTelNr Else temp = Left(alleTelNr, pos1 - 1)
                        Vorwahl = OrtsVW(temp)
                        alleTelNr = Mid(alleTelNr, pos1 + 1)
                    Loop Until pos1 = 0 Or Not InStr(1, TelNr, Vorwahl, vbTextCompare) = 0
                    TelNr = formatTelNr(TelNr, Vorwahl, "0041", False)
                End If
            End If
            ' Rückgabewert ermitteln
            RWStelsearch = Left(vCard, 11) = "BEGIN:VCARD"
            i = i + 1
            tempTelNr = Left(tempTelNr, Len(tempTelNr) - 2) & 0
        Loop Until RWStelsearch Or i = 3
        ' Besonderheit bei 'telsearch': Vor- und Nachname sind in vCard separat angegeben
        ' wenn kein Vorname vorhanden ist, dann "muss" es sich um eine Firma handeln
        ' dann wird der volle Name in der vCard (FN) in den Firmennamen (ORG) übertragen
        If RWStelsearch Then
            If InStr(1, ReadFromVCard(vCard, "N", ""), ";;;;", vbTextCompare) Then
                vCard = Replace(vCard, Chr(10) & "FN:", Chr(10) & "ORG:", , , vbTextCompare)
            End If
        End If
    Exit Function
    catch:
        MsgBox "Fehler: " & Err.Description, vbCritical, "Fehler"
    End Function
    formConfig habe ich so ergänzt:
    Code:
        ' Einstellungen für die Rückwärtssuche laden
        Me.ComboBoxRWS.AddItem ("DasÖrtliche")
        Me.ComboBoxRWS.AddItem ("GoYellow.de")
        Me.ComboBoxRWS.AddItem ("11880.com")
        Me.ComboBoxRWS.AddItem ("telsearch")
        Me.ComboBoxRWS.ListIndex = GetSetting("FritzBox", "Optionen", "CBoxRWSuche", 0)
    Leider habe ich noch nicht die neuste Version installiert.

    Gruss Guido

    [Edit wichard:
    Code:
    -Tags eingefügt.][/COLOR][/I]
     
  6. Kruemelino

    Kruemelino Aktives Mitglied

    Registriert seit:
    21 Jan. 2006
    Beiträge:
    1,045
    Zustimmungen:
    1
    Punkte für Erfolge:
    38
    Beruf:
    Dipl.-Ing.
    Ort:
    Radeburg
    mal ne andere frage wie funktioniert das makro denn in der schweiz?
    gibt es probleme mit der Rufnummernformatierung?
     
  7. tzhscgu3

    tzhscgu3 Neuer User

    Registriert seit:
    20 Okt. 2006
    Beiträge:
    32
    Zustimmungen:
    0
    Punkte für Erfolge:
    0
    #7 tzhscgu3, 24 Apr. 2007
    Zuletzt bearbeitet: 24 Apr. 2007
    Das Makro funktioniert in der Schweiz exakt genau gleich, wie diese von goyellow oder 11880.

    Ich habe einfach eine Rückwärtssuche von Dir kopiert und diese für telsearch angepasst.
    Zuerst hat es nicht funktioniert und dann habe ich die Rückwärtssuche von goyellow und 11880 genauer unter die Lupe genommen, bis ich verstand, wie diese funktionieren. Dann konnte ich telsearch zum laufen bringen.

    An der Nummerformatierung aus der vcard musste ich nichts ändern. Diese funktioniert ohne Probleme.

    Gruss
     
  8. Kruemelino

    Kruemelino Aktives Mitglied

    Registriert seit:
    21 Jan. 2006
    Beiträge:
    1,045
    Zustimmungen:
    1
    Punkte für Erfolge:
    38
    Beruf:
    Dipl.-Ing.
    Ort:
    Radeburg
    #8 Kruemelino, 25 Apr. 2007
    Zuletzt bearbeitet: 26 Apr. 2007
    Danke. Ich werd die Änderungen bei Gelegenheit mal mit einbauen. Bei der nächsten Version wird es bei der Nurrmernformatierung Änderungen geben. Es sollte aber weiterhin funktionieren.

    EDIT:

    Ich hab es gerade Eingebaut. Allerdings kann ich es nur schwer testen. Das darfst du machen. Allerdings gibt es die einbindung nur in der neuen Version mit XMLHTTP.