VBA Tipp: E-Mail-Adresse aus Textfeld extrahieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte aus einem Datenbankfeld "Kommentar" eine E-Mail-Adresse extrahieren und in ein anderes Feld "EMail" übertragen. Die E-Mail-Adresse kann an einer beliebigen Stelle in dem Feld "Kommentar" stehen.

Lösung

Das geht mit folgender VBA-Funktion:

Public Function ExtractEMailAddr(Mailtext As Variant) As Variant
 
   ' Quelle: http://www.dbwiki.net/
 
   Dim SepPos  As Long
   Dim AtPos   As Long
   Dim i       As Long
 
   ExtractEMailAddr = Null
 
   If Len(Mailtext) Then
 
      For i = 1 To Len(Mailtext)
         Select Case LCase$(Mid$(Mailtext, i, 1))
            Case "a" To "z", "0" To "9", "-", "_", "."
               ' nichts tun
            Case "@"
               AtPos = i
            Case Else
               If AtPos > 0 Then
                  Exit For
               End If
               SepPos = i
         End Select
      Next
 
      If AtPos > 0 Then
         ExtractEMailAddr = Mid$(Mailtext, SepPos + 1, i - SepPos - 1)
      End If
 
   End If
 
End Function

Aufruf

So können die Daten im Feld "Kommentar" aussehen:

"Nur Montags anliefern, hans@meiser.de, Tel.:2135464"
"www.beispiel.de heinz@beispiel.de / Hobby ist Fußball"

"peter@mueller.de, 18,30 DM EK"
"peter@mueller.de,18,30 DM EK"
"18,30 DM EK, peter@mueller.de"
"18,30 DM EK,peter@mueller.de"

Beispiel 1:
Damit kann man jetzt z.B. eine Aktualisierungsabfrage aufbauen mit folgender SQL

UPDATE MeineTabelle SET [EMail] = ExtractEMailAddr([Kommentar])

Beispiel 2:
Verwendung der Funktion in einer Ereignisprozedur

Private Sub Kommentar_AfterUpdate()
   Me.EMail = ExtractEMailAddr(Me.Kommentar)
End Sub

Beispiel 3:
Darstellung des Ergebnisses im VBA Direktfenster

 Debug.Print ExtractEMailAddr("Nur Montags anliefern, hans@meiser.de, Tel.:2135464")
 ' ergibt hans@meiser.de