VBA Tipp: Access 2000 String-Funktionen in Access 97 nutzen

Problem

Ich habe ein VBA-Code-Beispiel, in dem Funktionen wie "Replace", "Split", "Join", "StrReverse" oder "InstrRev" vorkommen, diese Funktionen kennt mein Access 97 aber nicht.

Lösung

Diese neuen Funktionen von Access 2000 kann man wie folgt nachbilden:

Public Function Join(source() As String, Optional _
    sDelim As String = " ") As String
Dim sOut As String, iC As Long
On Error GoTo errh
  For iC = LBound(source) To UBound(source) - 1
    sOut = sOut & source(iC) & sDelim
  Next
  sOut = sOut & source(iC)
  Join = sOut
  Exit Function
errh:
  Err.Raise Err.Number
End Function
 
Public Function Split(ByVal sIn As String, Optional sDelim As _
  String, Optional nLimit As Long = -1, Optional bCompare As _
   Long = vbBinaryCompare) As Variant
Dim sRead As String, sOut() As String, nC As Long
  If sDelim = "" Or Len(sDelim) > Len(sIn) Then
    ReDim Preserve sOut(0)
    sOut(0) = sIn
  Else
    sIn = sIn & sDelim
    Do While sIn <> "" And Len(sDelim) < Len(sIn)
      sRead = ReadUntil(sIn, sDelim, bCompare)
      ReDim Preserve sOut(nC)
      sOut(nC) = sRead
      nC = nC + 1
      If nLimit <> -1 And nC >= nLimit Then Exit Do
    Loop
  End If
  Split = sOut
 End Function
 
Private Function ReadUntil(ByRef sIn As String, _
    sDelim As String, Optional bCompare As Long = vbBinaryCompare) As String
Dim nPos As Long
  nPos = InStr(1, sIn, sDelim, bCompare)
  If nPos > 0 Then
    ReadUntil = Left(sIn, nPos - 1)
    sIn = Mid(sIn, nPos + Len(sDelim))
  End If
 End Function
 
Public Function StrReverse(ByVal sIn As String) As String
Dim nC As Long, sOut As String
  sOut = ""
  For nC = Len(sIn) To 1 Step -1
    sOut = sOut & Mid(sIn, nC, 1)
  Next
  StrReverse = sOut
End Function
 
Public Function InStrRev(ByVal sIn As String, sFind As String, _
 Optional nStart As Long = 1, Optional bCompare As _
    Long = vbBinaryCompare) As Long
  Dim nPos As Long
  sIn = StrReverse(sIn)
  sFind = StrReverse(sFind)
  nPos = InStr(nStart, sIn, sFind, bCompare)
  If nPos = 0 Then
    InStrRev = 0
  Else
    InStrRev = Len(sIn) - nPos - Len(sFind) + 2
  End If
End Function
 
Public Function Replace(sIn As String, sFind As String, _
    sReplace As String, Optional nStart As Long = 1, _
    Optional nCount As Long = -1, Optional bCompare As _
    Long = vbBinaryCompare) As String
 
Dim nC As Long, nPos As Long, sOut As String
  sOut = sIn
  nPos = InStr(nStart, sOut, sFind, bCompare)
  If nPos <> 0 Then
    Do
      nC = nC + 1
      sOut = Left(sOut, nPos - 1) & sReplace & _
         Mid(sOut, nPos + Len(sFind))
      If nCount <> -1 And nC >= nCount Then Exit Do
      nStart = nPos + Len(sReplace)
      nPos = InStr(nStart, sOut, sFind, bCompare)
    Loop While nPos > 0
  End If
  Replace = sOut
End Function

Quelle: HOWTO: Simulate Visual Basic 6.0 String Functions in VB5

Anmerkung

Die Originalfunktionen sind so nicht verwendbar bzw. buggy:

• gibt es in A97 keine ENums,
• ist ein Fehler in Split (leere Teilstrings führen zum Abbruch),
• muss nPos in ReadUntil als Long deklariert werden,
• führt die Verwendung von Integers dazu, dass bei sehr langen Strings ein Überlauf eintritt,
• wird in Replace immer wieder von vorne gesucht - Replace("test.test",".","..") führt also zu einer Totschleife.

Hinweis

Sehr hilfreich können diese Funktionen sein, wenn man mit bedingter Kompilierung arbeitet.

Dazu sollten, mit Ausnahme der Join-Funktion (da diese eigentlich eine VB-Funktion ist und auch nicht in VBA6 funktioniert), vor den Funktionen ein bedingter Kompilierungsblock gesetzt werden.

Beispiel

#If VBA6 = False Then
  'Code, der nur in Nicht-VBA 6-Umgebung ausgeführt wird
#End If