[Gelöst] Fritzbox 7390: Telefonieren mit dem PC (Outlook führend, kein Skype)

Private Declare [B]PtrSafe[/B] Sub apiSleep Lib "[B]KERNEL64.DLL[/B]" Alias "Sleep" _
(ByVal dwMilliseconds As Long)

Public PhonerCmd As String
Public TgebPfad As String
Public SerSchnittstelle As String
Public Anlage As String
Sub NummerWählen()

'-----------------------------------Einstellungen Anfang
'
'Hier bitte den Pfad für TGeb an eigene Installation anpassen
TgebPfad = "C:\Programme\tgeb"
'
'Optional:
SerSchnittstelle = "[B]COM4[/B]" 'für das Wählen über Datenkabel oder Bluetooth mit dem Handy
Anlage = "COM1" 'für das Wählen über geeignete Telefonanlage mit asoziierter Wahl
'
'-----------------------------------Einstellungen Ende


'Hier geht's los
'erstmal Wählliste aller relevanter Nummern erstellen

Set myOlApp = CreateObject("Outlook.Application")
Set myexplorer = myOlApp.ActiveExplorer
Set mySelectedItems = myexplorer.Selection
Set Eintrag = mySelectedItems.Item(1)
Set ablage = New DataObject



'Befinden wir uns auch im Kontakte-Ordner?
If myexplorer.Caption = "[B]Kontakte - Outlook - Microsoft Outlook[/B]" Then

    DialForm.Eintrag.Caption = Eintrag.CompanyName & Eintrag.FullName
    
    NummerEintragen (Eintrag.MobileTelephoneNumber)
    NummerEintragen (Eintrag.BusinessTelephoneNumber)
    NummerEintragen (Eintrag.OtherTelephoneNumber)
    NummerEintragen (Eintrag.Business2TelephoneNumber)
    NummerEintragen (Eintrag.AssistantTelephoneNumber)
    NummerEintragen (Eintrag.CarTelephoneNumber)
    NummerEintragen (Eintrag.CompanyMainTelephoneNumber)
    NummerEintragen (Eintrag.PrimaryTelephoneNumber)
    NummerEintragen (Eintrag.HomeTelephoneNumber)
    NummerEintragen (Eintrag.Home2TelephoneNumber)
    NummerEintragen (Eintrag.RadioTelephoneNumber)
    NummerEintragen (Eintrag.CallbackTelephoneNumber)
    DialForm.Show

Else
'Wir befinden uns nicht im Kontakte-Ordner. Wir nehmen einfach die Nummer aus der Zwischenablage
    DialForm.Eintrag.Caption = "Zwischenablage"
    ablage.GetFromClipboard
    NummerEintragen Trim(ablage.GetText(1))
    DialForm.Show
    
End If

End Sub
Sub NummerEintragen(Nummer As String)

'damit werden alle Sonderzeichen wie Leerzeichen und Klammern entfernt
'Nummer wird in Wählliste eingetragen
    
    If Not Trim(Nummer) = "" Then
    For i = 1 To Len(Nummer)
        If Asc(Mid(Nummer, i, 1)) > 47 And Asc(Mid(Nummer, i, 1)) < 58 Then Fnummer = Fnummer & Mid(Nummer, i, 1)
    Next
    End If
    If Left(Trim(Nummer), 1) = "+" Then
        Fnummer = "00" & Fnummer
        If Mid(Fnummer, 5, 1) = "0" Then Fnummer = Left(Fnummer, 4) & Right(Fnummer, Len(Fnummer) - 5)
    End If
    If Left(Fnummer, 4) = "0049" Then
        Fnummer = Right(Fnummer, Len(Fnummer) - 4)
        Fnummer = "0" & Fnummer
    End If

    If Not Trim(Nummer) = "" Then DialForm.Nummernliste.AddItem (Fnummer)
End Sub
Sub dial(Nummer As String)
    
'hiermit wird gewählt

    Dim Phoner As Object
    Set Phoner = CreateObject("Phoner.CPhoner")

 If DialForm.Anlage.Value = True Then
    'Wählen wir über die Anlage über COM oder LPT (Freigabe auf Server)?
    'LPT2 zeigt auf Server, dort Druckerfreigabe auf serieller Schnittstelle
    Open Anlage For Output As #1
    If DialForm.LCR.Value = True Then
        Print #1, "atd" + LCR(Nummer)
    Else
        Print #1, "atd" + Nummer
    End If
    Close #1
 End If
 
 If DialForm.BT.Value = True Then
    'Wählen wir über die serielle Schnittstelle bzw. Bluetooth auf Handy?
    'T610 liegt auf COM6 (Bluetooth)
    Open SerSchnittstelle For Output As #1
        Print #1, "atd" + Nummer + ";"
    Close #1
 End If
 
 If DialForm.Phoner.Value = True Then
    'Wählen wir über Phoner?
    If DialForm.LCR.Value = True Then
        Phoner.makecall (LCR(Nummer))
    Else
        Phoner.makecall (Nummer)
    End If
 End If
 
End Sub
Function LCR(Nummer As String)
   'LCR Modul
      
   rufnummerdatei = TgebPfad + "\RNUMMER.TXT"
   'wir gehen über die Datei, schneller als Zwischenablage
    
   Set fs = CreateObject("Scripting.FileSystemObject")
   If fs.fileexists(rufnummerdatei) Then _
    fs.deletefile rufnummerdatei
   
   cmdstring = TgebPfad + "\tgeb.exe /n:" + Nummer + " /Datei:" + rufnummerdatei + " /min /nurnummer /A:AUTO /D:01:00"
   result = Shell(cmdstring, 1)
    
    While Not fs.fileexists(rufnummerdatei)
       apiSleep 500
    Wend
    
    Open rufnummerdatei For Input As #10
       Line Input #10, ergebnis
    Close #10
    
    
    If InStr(1, ergebnis, "-") Then
       Vorwahl = Left(ergebnis, InStr(1, ergebnis, "-") - 1)
       Rufnummer = Right(ergebnis, Len(ergebnis) - InStr(1, ergebnis, "-"))
       ergebnis = Vorwahl + Rufnummer
    End If
    LCR = ergebnis
End Function