New user
Beiträge: 3
| Hallo,
ist nicht ganz einfach, weil die Eingebenden so kreativ sind. Ich hatte so ein Funktion vor einiger Zeit geschrieben, allerdings für deutsche Rufnummern. Vorgehensweise: Tabelle mit allen Vorwahlen anlegen, dann aus der eingetragenen Rufnummer alle Sonderzeichen entfernen und dann die ersten 2 Zeichen der Rufnummer prüfen ob in Vorwahltabelle -> nicht gefunden, dann die ersten 3 Ziffern (4 Ziffern). Gefundene Vorwahl und Rest in getrennte Felder schreiben. Als Abfallprodukt erhält man die nicht Gefundenen = falschen Rufnummern. Nebenstellen bekommt man nur hin, wenn man einen Verleich mit der Zentralnummer machen kann, da häufig auch kein Trennzeichen angegeben wird.
Der beste Weg ist in der Eingabemaske alles getrennt erfassen.
Bei den internationalen Vorwahlen ist es problematisch, weil hier auch einige deutsche Vorwahlen mit den gleichen Ziffern anfangen. Ich hab hier für einen Telefonanlagenvergleich den Umweg über das Land im Datensatz gemacht. Hier brauchte ich aber nicht die Trennung der nationalen Vorwahl, da in der TK die Rufnummer nur eine Zahl ist. Wenn man sicher ist, dass die internationale Vorwahl immer enthalten ist, kann man auch die ausdokumentierte Alternative nehmen.
' Richtige Auslandsvorwahl unabhängig von Schreibweise ermittel
Function cleanTelNrLand(RufNr As Variant, sLand As Variant) As Variant
' Normalisiert Telefonnummern
' Parameter RufNr = Telefonnummer, sLand = Land aus der Adresse
Dim sIVW, sVW, sRufNr As String
If IsNull(RufNr) Then cleanTelNrLand = Null: Exit Function 'Wenn Null nicht machen
RufNr = killSonderzeichen(RufNr) 'Nur noch Zahlen übergeben
sRufNr = RufNr
sIVW = DLookup("[IVW]", "intVorW", "[Land] = '" & sLand & "'") ' Vorwahl aus Tabelle mit Landesvorwahlen holen
If IsNull(sIVW) Then ' Vorwahl nicht gefunden
MsgBox ("Achtung! Es wurde kein Land in der Tabelle gefunden! Land: " & sLand & " Rufnummer: " & RufNr)
Else ' Vorwahl gefunden
If Left(sRufNr, Len(sIVW) - 2) = Right(sIVW, Len(sIVW) - 2) Then '
sRufNr = "00" & sRufNr
Else
sRufNr = sIVW & sRufNr
End If
'Alternative falls kein Landesfeld verwendet werden soll --> Prüfen ob Anfangszeichen eine Auslandsvorwahl ist.
'If IsIVW(Left(RufNr, 4)) Then
' sIVW = "00" & Left(RufNr, 4)
' sRufNr = Mid(RufNr, 5)
' GoTo EndeIVW
' End If
' If IsIVW(Left(RufNr, 3)) Then
' sIVW = "00" & Left(RufNr, 3)
' sRufNr = Mid(RufNr, 4)
' GoTo EndeIVW
' End If
' If IsIVW(Left(RufNr, 2)) Then
' sIVW = "00" & Left(RufNr, 2)
' sRufNr = Mid(RufNr, 3)
' GoTo EndeIVW
' End If
End If
EndeIVW:
cleanTelNrLand = sRufNr
End Function
Function killSonderzeichen(RufNr As Variant) As Variant
' Alle Zahlen und führende Nullen aus Rufnummer entfernen
Dim i As Integer
Dim sTemp, sChar As String
Dim bNrStart As Boolean
bNrStart = False
If IsNull(RufNr) Then killSonderzeichen = Null: Exit Function
For i = 1 To Len(RufNr) ' Jedes Zeichen einzeln prüfen.
sChar = Mid(RufNr, i, 1)
If IsNumeric(sChar) Then
If sChar = "0" And bNrStart = False Then 'führende Nullen entfernen
Else
sTemp = sTemp & sChar
bNrStart = True
End If
End If
Next i
killSonderzeichen = sTemp
End Function
Public Function IsIVW(ByVal sIVW) As Boolean
' Prüft ob in Auslandsvorwahltabelle enthalten
If DCount("*", "IntVorw", "IVW='00" & sIVW & "'") Then
IsIVW = True
End If
End Function
Gruß Conrad |
