habe versucht eine schleife zubauen !
Dim RegExp As VBScript_RegExp_55.RegExp
Dim Matches As VBScript_RegExp_55.MatchCollection
Dim Expr As String
Dim start As Date, jetzt As Date
Dim Schleife As Long
start = Now
Do While jetzt < start + TimeSerial(0, 0, 1)
jetzt = Now
Schleife = Schleife + 1
Loop
Debug.Print "Schleife wurde" & Schleife & " mal durchlaufen"
With New RegExp
.Global = False
.IgnoreCase = True
.MultiLine = False
With Worksheets("Tabelle1").Range("A1")
Expr = .Offset(0, 0).Value & .Offset(1, 0).Value & .Offset(2, 0).Value
End With
.Pattern = """<img(.*?)>.*?</img>""(,\d+)"
Set Matches = .Execute(Expr)
Dim Part1 As String
Dim Part2 As String
Dim Part3 As String
If Matches.Count > 0 Then
Part1 = Left$(Expr, Matches(0).FirstIndex)
Part3 = Matches(0).SubMatches(1)
.Pattern = "src=""""(.+?)"""""
Set Matches = .Execute(Expr)
If Matches.Count > 0 Then
Part2 = Matches(0).SubMatches(0)
Else
Range("A5").Value = ""
Call MsgBox("Angabe zu Image-Source nicht gefunden.", vbExclamation)
Exit Sub
End If
Range("A5").Value = Part1 & Part2 & Part3
Call MsgBox("Fertig.", vbInformation)
Else
Range("A5").Value = ""
Call MsgBox("Nix gefunden.", vbExclamation)
End If
End With
End Sub