AW: @mumpel, kannst mal bitte hier schauen
10.03.2009 19:33:53
mumpel
Hallo!
Der Code verbirgt sich natürlich im VBA-Projekt. Das Hauptmakro sieht wie folgt aus (muss in ein Standardmodul). Den Quellcode gibt es als HTML-Dokumentation auf Nachfrage (nur per Email). Der Beispielcode ist allerdings aus dem Office 2007-AddIn. Nicht benötigtes muss entfernt werden.
Zuerst aber muss man den API-Code in ein Standardmodul einfügen.
Option Private Module
Option Explicit
Declare Function tapiRequestMakeCall Lib "Tapi32.dll" (ByVal DestAddress As String, _
ByVal AppName As String, ByVal CalledParty As String, ByVal Comment As String) As Long
Public A$
Sub Telefonieren(TelefonNr$, derName$)
Application.EnableCancelKey = False
Dim retval As Long
retval = tapiRequestMakeCall(TelefonNr, "", derName, "")
If retval <> 0 Then
MsgBox "Beim Verbindungsaufbau ist ein Fehler aufgetreten!"
End If
End Sub
Das folgende Makro übergibt die zu wählende Rufnummer an die TAPI-Schnittstelle (sofern die Bedingungen übereinstimmen). Vor der Übergabe der Rufnummer findet noch eine Bereinigung des Zellinhaltes und eine Prüfung des Selben statt.
Public Sub NummerAnWählhilfeÜbergeben(strT As String, Name As String)
Application.EnableCancelKey = False
Dim cancel As Boolean
Dim i As Integer
Dim s As String
Dim ST As String
If strT = "" Then GoTo Prüfpunkt
Rem Ersetzen von Sonderzeichen in zu wählenden Rufnummern
Rem "ST" = Auslesen der Länderkennung (in Registry gespeichert)
ST = GetSetting("RMH_Installationen", "w2007", "STKenn")
strT = Replace(strT, "_", " ")
strT = Replace(strT, "<", " ")
strT = Replace(strT, ">", " ")
strT = Replace(strT, "[", " ")
strT = Replace(strT, "]", " ")
strT = Replace(strT, "~", " ")
strT = Replace(strT, "*", " ")
strT = Replace(strT, "#", " ")
strT = Replace(strT, "\", " ")
strT = Replace(strT, "/", " ")
strT = Replace(strT, "-", " ")
strT = Replace(strT, "(", " ")
strT = Replace(strT, ")", " ")
If ST = "DE" And Left(strT, 3) = "+49" Then
strT = Replace(strT, "+49", "0")
ElseIf ST = "AT" And Left(strT, 3) = "+43" Then
strT = Replace(strT, "+43", "0")
ElseIf ST = "CH" And Left(strT, 3) = "+42" Then
strT = Replace(strT, "+42", "0")
End If
Rem "s" = Auslesen der Einstellung für Gültigkeitsprüfung (in Registry gespeichert)
s = GetSetting("RMH_Installationen", "Pruefung", "2")
If s = "0" Then GoTo VorwahlPrüfung
If Left(strT, 1) = "+" Then
strT = Replace(strT, "+", "00 ")
GoTo VorwahlPrüfung
End If
strT = Replace(strT, " ", "")
Rem Ende Ersetzen
Rem Beginn Gültigkeitsprüfung
For i = Len(strT) To 1 Step -1
If IsNumeric(strT) And Len(strT) > 5 And Left(strT, 1) = "0" And Not IsDate(strT) Then GoTo VorwahlPrüfung
Next i
Prüfpunkt:
MsgBox "Der Text entspricht keiner gültigen Telefonnummer. " & Chr(13) & _
"Der Vorgang wurde abgebrochen!!! " & Chr(13) & _
"Die Telefonnummer muss mindestens sechsstellig sein. " & Chr(13) & Chr(13) & _
"Bitte immer die Ortsvorwahl mit angeben ! " & Chr(13) & _
"Bitte nur gültige Telefonnummern angeben! " & Chr(13) & _
"z.B. 0891234 oder +43(1)1234567. " & Chr(13) & _
" " & Chr(13) & Chr(13), vbOKOnly, "Anwenderfehler !!!"
Exit Sub
Rem Ende Güligkeitsprüfung
Rem Beginn Vorwahlprüfung
VorwahlPrüfung:
strT = Replace(strT, "R", "")
If Left(strT, 4) = "0800" Then GoTo NummerServicedienste
If Left(strT, 4) = "0190" Or Left(strT, 4) = "0180" _
Or Left(strT, 4) = "0137" Or Left(strT, 4) = "0900" _
Or Left(strT, 4) = "0136" Then GoTo ServiceWarnung
If Left(strT, 3) = "010" Or Left(strT, 3) = "011" Then GoTo AnbieterVorwahl
If Left(strT, 2) = "00" Then GoTo NummerAusland
If Left(strT, 4) = "0151" Or Left(strT, 4) = "0152" _
Or Left(strT, 4) = "0159" Or Left(strT, 4) = "0160" _
Or Left(strT, 4) = "0162" Or Left(strT, 4) = "0163" _
Or Left(strT, 4) = "0170" Or Left(strT, 4) = "0171" _
Or Left(strT, 4) = "0172" Or Left(strT, 4) = "0173" _
Or Left(strT, 4) = "0174" Or Left(strT, 4) = "0175" _
Or Left(strT, 4) = "0176" Or Left(strT, 4) = "0177" _
Or Left(strT, 4) = "0178" Or Left(strT, 4) = "0179" Then GoTo NummerMobilfunkInland
Rem Ende Vorwahlprüfung
Rem Beginn Wahlvorgang einleiten
Rem Wählen Festnetznummern Inland
Rem Definierte Anbietervorwahl für Festnetz wird
Rem automatisch vorangestellt
NummerFestnetzInland:
A$ = GetSetting("RMH_Installationen", "w2007", "CBCF") & strT
Telefonieren A, Name
cancel = True
Exit Sub
Rem Wählen Telefonnummern Ausland
Rem Definierte Anbietervorwahl für Auslandsgespräche wird
Rem automatisch vorangestellt
NummerAusland:
If GetSetting("RMH_Installationen", "w2007", "CBCA") = "" Then
A$ = strT
Else
A$ = GetSetting("RMH_Installationen", "w2007", "CBCA") & " " & strT
End If
Telefonieren A, Name
cancel = True
Exit Sub
Rem Wählen Mobilfunknummern Inland
Rem Definierte Anbietervorwahl für Mobilfunk wird
Rem automatisch vorangestellt
NummerMobilfunkInland:
A$ = GetSetting("RMH_Installationen", "w2007", "CBCM") & strT
Telefonieren A, Name
cancel = True
Exit Sub
Rem Wählen von Sonderrufnummern (Call By Call wird nicht berücksichtigt)
NummerServicedienste:
A$ = strT
Telefonieren A, Name
cancel = True
Exit Sub
Rem Ende Wahlvorgang einleiten
Rem Beginn Meldung 0190-Warner
ServiceWarnung:
Rem Auslesen der Einstellung für 0190-Warner (in Registry gespeichert)
If GetSetting("RMH_Installationen", "Warner", "2") = "0" Then GoTo NummerServicedienste
If MsgBox _
("Sie versuchen, eine Servicenummer zu wählen. " & Chr(13) & Chr(13) & _
"Es könnte sich um eine teure Servicenummer handeln. " & Chr(13) & Chr(13) & _
"****** Möchten Sie dies wirklich? ****** " & Chr(13) & Chr(13) & _
"Klicken Sie auf ja, wenn Sie die Nummer wählen möchten! " & Chr(13) & Chr(13) & _
"Klicken Sie auf nein, um den Vorgang abzubrechen! ", 308, " *** Sicherheitsfrage *** ") = 6 Then _
GoTo NummerServicedienste
Exit Sub
Rem Ende Meldung 0190-Warner
Rem Beginn Meldung Anbietervorwahl
AnbieterVorwahl:
MsgBox "Sie haben versucht, eine Anbietervorwahl zu benutzen." & Chr(13) & _
"Aus Sicherheitsgründen ist dies nicht erlaubt. Dadurch " & Chr(13) & _
"wären die Sicherheitseinstellungen umgehbar." & Chr(13) & Chr(13) & _
"***** Der Vorgang wurde abgebrochen *****", vbOKOnly + vbExclamation, "Sicherheitshinweis"
Exit Sub
Rem Ende Meldung Anbietervorwahl
Ende:
End Sub
Das foldende Makro (dem Kontextmenü-Button zugewiesen), welches dem CommandButton zugewiesen werden muss (der Eintrag im Kontextmenü wird beim Installieren des AddIns erzeugt), übergibt den Zellinhalt an das Wählmakro.
Sub NummerSenden()
NummerAnWählhilfeÜbergeben ActiveCell.Value, " "
End Sub
Code eingefügt mit VBA in HTML 2.0size>
Allerdings ist es schwierig, das Ganze zu verstehen, wenn man nicht den gesamten Quellcode sieht.
Gruß, René