Rubrik: Variablen/Strings · String-Operationen | VB-Versionen: VB6, VBA | 13.08.10 |
Zeichenfolge zwischen 2 Zeichen suchen Ermitteln einer Zeichenfolge zwischen 2 Zeichen. | ||
Autor: Richard Mittelstädt | Bewertung: | Views: 16.097 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Nachfolgende Funktion gibt die Zeichenfolge innerhalb eines Strings zurück, die sich zwischen zwei bestimmten Zeichen befindet. Kriterium ist ein Such-String, in dem Platzhalter erlaubt sind (zB. in .asp nach URL-Adresse suchen).
Public Function SucheStringZwischenZeichen(sText, sString, _ Optional ZchLINKS As String = """", Optional ZchRECHTS = """", _ Optional lIndex = 1, _ Optional Von_RECHTS = False) ' ****************************************************************************** ' sText zu durchsuchender Text ' sString zu suchender String: ' PLATZHALTER sind (like-Syntax, zB. "*/lpt*[0-9].zip") erlaubt !!!!! ' ZchLINKS Linkes Begrenzungs-Zeichen Optional, Standard: " ' Ist normalerweise gleich: ' ZchRECHTS Rechtes Begrenzungs-Zeichen Optional, Standard: " ' lIndex Das lIndex-te Vorkommen suchen Standard: 1 (erstes Vorkommen) ' Von_RECHTS Suchrichtung (True=Von Rechts) Standard: False (= Von Links suchen) ' ' Man kann zB. eine .ASP-Datei einlesen, in sText übergeben und dann ' nach aktuellen (dyn.)URL-Angaben zwischen zwei "- Zeichen suchen lassen. ' ' Wenn sString zwischen den beiden Zeichen entsprechend gefunden wird, ' dann wird der gesamte Text zwischen den beiden Zeichen zurückgegeben. ' Es wird das lIndex-te Vorkommen (von links bzw. rechts) ausgegeben. ' Wird das lIndex-te Vorkommen nicht gefunden, ist die Rückgabe "" . ' ****************************************************************************** Dim Pos1 As Long ' Pos. linkes Zeichen Dim Pos3 As Long ' Pos. rechtes Zeichen Dim n As Long ' Zähler aktuell n-tes Vorkommen Dim sTemp As String ' zu untersuchender Text On Error GoTo ERR_01 SucheStringZwischenZeichen = "" sTemp = sText If Not sTemp Like "*" & ZchLINKS & sString & ZchRECHTS & "*" Then Exit Function End If n = 0 If Von_RECHTS = False Then ' *************************** Suche von LINKS *********************************** Pos1 = 0 ' Am Anfang anfangen SEARCH_NEXT_L: ' Nächstes Vorkommen suchen Pos1 = Pos1 + 1 If Not Mid(sTemp, Pos1) Like "*" & ZchLINKS & sString & ZchRECHTS & "*" Then Exit Function ' kommt RECHTS nicht mehr vor Else ' --- Muss mind. noch einmal RECHTS vorkommen ----- Pos1 = InStr(Pos1, sTemp, ZchLINKS) Pos3 = InStr(Pos1 + 1, sTemp, ZchRECHTS) If Mid(sTemp, Pos1, Pos3 - Pos1 + 1) Like _ ZchLINKS & sString & ZchRECHTS Then n = n + 1 ' Gefunden zum n-ten mal. End If If n < lIndex Then GoTo SEARCH_NEXT_L ' Nächstes Vorkommen suchen End If End If Else ' *************************** Suche von RECHTS ********************************** Pos3 = Len(sTemp) + 1 ' Am Ende anfangen SEARCH_NEXT_R: ' Nächstes Vorkommen suchen Pos3 = Pos3 - 1 If Not Mid(sTemp, 1, Pos3) Like "*" & ZchLINKS & sString & ZchRECHTS & "*" Then Exit Function ' kommt LINKS nicht mehr vor Else ' --- Muss mind. noch einmal LINKS vorkommen ------ Pos3 = InStrRev(sTemp, ZchRECHTS, Pos3) Pos1 = InStrRev(sTemp, ZchLINKS, Pos3 - 1) If Mid(sTemp, Pos1, Pos3 - Pos1 + 1) Like _ ZchLINKS & sString & ZchRECHTS Then n = n + 1 ' Gefunden zum n-ten mal. End If If n < lIndex Then GoTo SEARCH_NEXT_R ' Nächstes Vorkommen suchen End If End If End If If n = lIndex Then SucheStringZwischenZeichen = Mid(sTemp, Pos1 + 1, Pos3 - Pos1 - 1) End If Exit Function ERR_01: MsgBox "SucheStringZwischenZeichen(...): " & Err.Number & vbNewLine & Err.Description End Function
Private Function testsuchstrpl0897() Dim t1 t1 = "asdfspäter_" & Chr(34) & "-blablee.exe7" & _ Chr(34) & "_bbb" & Chr(34) & "-blablee.exe8" & Chr(34) MsgBox SucheStringZwischenZeichen(t1, "*.exe*", , , 2, False) ' t1 = "asdfspäter_<-blablee.exe7>_bbbhhhhhhh_____<1234?.exe88>ghjkl" ' MsgBox SucheStringZwischenZeichen(t1, "*.exe*", "<", ">", 1, True) ' t1 = "asdfasdf_<http://www.trendmicro.com/ftp/products/" & _ ' pattern/lpt989.zip>_blaaaaaaaaaaaaaa" ' MsgBox SucheStringZwischenZeichen(t1, "*/lpt*[0-9].zip", "<", ">", 1, True) End Function