'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  extrahiert die erste Zahl der Länge laenge (default=5)
'+  im String ausdruck und übergibt sie an die Funktion plzAus
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function PLZAus(ByVal ausdruck As String, Optional laenge = 5) As String
zahl = False: ende = False
Dim sVar As String, i As Integer
    For i = 1 To Len(ausdruck)
             If InStr(1, "0123456789", Mid(ausdruck, i, 1)) And Not ende Then
                 sVar = sVar + Mid(ausdruck, i, 1)
                 zahl = True
                Else
                If zahl Then
                     If Len(sVar) <> laenge Then
                         zahl = False
                         sVar = ""
                         Else
                         Exit For
                        End If
                    End If
                End If
   Next
   PLZAus = sVar
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  extrahiert den Straßennamen aus dem String ausdruck
'+  und übergibt ihn an die Funktion StrasseAus
'+  Name der Straße ist ALLES links von Land & PLZ
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function StrasseAus(ausdruck, Optional plzlaenge = 5) As String
     plz = PLZAus(ausdruck, plzlaenge)
     Land = LandAus(ausdruck, plzlaenge)
     If Land > "" Then plz = Land & plz
     StrasseAus = Trim(Left(ausdruck, InStr(1, ausdruck, plz) - 1))
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  extrahiert den Ortsnamen aus dem String ausdruck
'+  und übergibt ihn an die Funktion OrtAus
'+  Name des Ortes ist ALLES rechts von PLZ
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function OrtAus(ausdruck, Optional plzlaenge = 5) As String
    plz = PLZAus(ausdruck, plzlaenge)
    OrtAus = Trim(Right(ausdruck, Len(ausdruck) - InStr(1, ausdruck, plz) + 1 - Len(plz)))
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  extrahiert die Länderkennzeichnung aus dem String ausdruck
'+  und übergibt sie an die Funktion LandAus
'+  WENN das Länderkennzeichen einem der Strings Land(0) bis Land(10)
'+  genau entspricht UND ZUSÄTZLICH davor ein "trennzeichen" 
'+  gefunden wird und zwischen Länderkennzeichen und PLZ max.
'+  EIN weiteres Zeichen liegt, dies gehört dann zum Länderkennzeichen
'+  und müßte EXTERN abgeschnitten werden!
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function LandAus(ausdruck, Optional plzlaenge = 5) As String
On Error Resume Next
   Dim Land(10) As String
   Dim trennzeichen As String
   Dim start As Integer
   Dim pos As Integer
   Dim plzpos As Integer
   trennzeichen = " ,;.:-_+*/\|"
   LandAus = ""
   Land(0) = "D": Land(1) = "F": Land(2) = "A"
   Land(3) = "I": Land(4) = "B": Land(5) = "E"
   Land(6) = "NL": Land(7) = "GB": Land(8) = "CH"
   Land(9) = "DK": Land(10) = "LUX"
   plz = PLZAus(ausdruck, plzlaenge)
   plzpos = InStr(1, ausdruck, plz)
   For i = 0 To UBound(Land())
      start = 2
      Do
         gefunden = True
         pos = InStr(start, Left(ausdruck, plzpos - 1), Land(i))
         If pos > 0 Then
             If InStr(1, trennzeichen, Mid(ausdruck, pos - 1, 1)) = 0 Then
                gefunden = False
                start = pos + 1
                 Else
                 If pos + Len(Land(i)) + 1 < plzpos Then
                    gefunden = False
                    start = pos + 1
                    Else
                    linker_teil = Left(ausdruck, InStr(1, ausdruck, plz) + Len(plz) - 1)
                    LandAus = Mid(linker_teil, pos - Len(Land(i)) + 1, Len(Land(i)) + 1)
                    End If
             End If
         End If
         Loop Until gefunden Or pos = 0
      Next i
End Function