Problem mit Regulärem Ausdr. (vbscript.regexp)
Rüdiger
ich möchte aus Internetseiten, die ich über VBA aktiviere (Adressen - und anderes - sind in Excelsheet gegeben) die Mailadresse ermitteln.
ransi hatte mir den folgenden Hinweis gegeben:
Code leicht angepasst:
Sub OuterSuch(ByVal oWebS As Object, strInAd As String)
Dim Antw As Long
Dim Quelltext As String
oWebS.Navigate strInAd
On Error GoTo errorhandler:
' Do While oWeb.Busy
' DoEvents
' Loop
Quelltext = oWebS.Document.documentelement.outerhtml
If Not oWebS Is Nothing Then
oWebS.Quit
Set oWebS = Nothing
End If
Antw = MsgBox(Quelltext, vbOKOnly, "Inhalt der Seite" & strInAd)
MsgBox Join(Email_Filter(Quelltext), vbCrLf)
strMailAdr = Join(Email_Filter(Quelltext), " ")
Antw = MsgBox("Mailadressen: " & strMailAdr, vbOKOnly)
ex1.Cells(i, 15).Value = strMailAdr
Exit Sub
errorhandler:
If Err.Number = 70 Then
Antw = MsgBox("Zugriff auf die Seite " & strInAd & " verweigert", vbOKCancel, " _
Laufzeitfehler")
Err.Clear
End If
End Sub
Public Function Email_Filter(strB As String) As Variant
Dim varTmp() As Variant
Dim Regex As Object
Dim m
Dim Treffer
Dim lngIndex As Long
Set Regex = CreateObject("Vbscript.regexp")
With Regex
.Pattern = "\b(\w[-.\w]*@\w[-.\w]*\.[a-zA-Z]{2,6})\b"
.IgnoreCase = False
.Global = True
Set Treffer = .Execute(strB)
' If Treffer.Count > 0 Then
ReDim varTmp(Treffer.Count - 1)
For Each m In Treffer
varTmp(lngIndex) = m.Value
lngIndex = lngIndex + 1
Next
' End If
End With
Email_Filter = varTmp
Set Regex = Nothing
End Function
Das funktioniert problemlos, wenn auf der Seite eine Mailadresse vorhanden ist, also ein String, auf den der Pattern zutrifft.
Aber wenn kein solcher String gefunden wird, gibt es die Meldung
Index außerhalb des gültigen Bereiches
auf der Zeile
ReDim varTmp(Treffer.Count - 1)
Jetzt habe ich - oben auskommentiert - versucht Treffer.count abzufragen auf > 0.
Nur ist zu dem Zeitpunkt Treffer.Count noch nicht belegt.
Wie kann ich diesen Fall abfangen, dass auf der fraglichen Seite keine Mailadresse gefunden wird?
Vielen Dank für Eure Hilfe!
Grüße aus dem Frankenland
Rüdiger