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

Aus DBWiki
Wechseln zu: Navigation, Suche

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(SourceArray() As String, Optional Delimiter As String = " ") As String
 
   Dim i As Long
 
   On Error GoTo errh
 
   For i = LBound(SourceArray) To UBound(SourceArray) - 1
      Join = Join & SourceArray(i) & Delimiter
   Next
   Join = Join & SourceArray(i)
   Exit Function
 
errh:
   Err.Raise Err.Number
End Function
 
Public Function Split(Expression As String, Optional Delimiter As String, _
                      Optional Limit As Long = -1, _
                      Optional Compare As Long = vbBinaryCompare) As Variant
   Dim buf        As String
   Dim resArray() As String
   Dim i          As Long
 
   If Len(Delimiter) = 0 Or Len(Delimiter) > Len(Expression) Then
      ReDim Preserve resArray(0)
      resArray(0) = Expression
   Else
      Expression = Expression & Delimiter
      Do While Len(Expression) > 0 And Len(Delimiter) < Len(Expression)
         buf = ReadUntil(Expression, Delimiter, Compare)
         ReDim Preserve resArray(i)
         resArray(i) = buf
         i = i + 1
         If Limit <> -1 And i >= Limit Then Exit Do
      Loop
   End If
   Split = resArray
End Function
 
Private Function ReadUntil(Expression As String, Delimiter As String, _
                           Optional Compare As Long = vbBinaryCompare) As String
   Dim nPos As Long
 
   nPos = InStr(1, Expression, Delimiter, Compare)
   If nPos > 0 Then
      ReadUntil = Left$(Expression, nPos - 1)
      Expression = Mid$(Expression, nPos + Len(Delimiter))
   End If
End Function
 
Public Function StrReverse(ByVal Expression As String) As String
   Dim i As Long
 
   For i = Len(Expression) To 1 Step -1
      StrReverse = StrReverse & Mid$(Expression, i, 1)
   Next
End Function
 
Public Function InStrRev(StringCheck As String, StringMatch As String, _
                         Optional Start As Long = 1, _
                         Optional Compare As Long = vbBinaryCompare) As Long
   Dim nPos As Long
 
   StringCheck = StrReverse(StringCheck)
   StringMatch = StrReverse(StringMatch)
   nPos = InStr(Start, StringCheck, StringMatch, Compare)
   If nPos > 0 Then
      InStrRev = Len(StringCheck) - nPos - Len(StringMatch) + 2
   End If
End Function
 
Public Function Replace(Expression As String, Find As String, _
                        ReplaceWith As String, Optional Start As Long = 1, _
                        Optional Count As Long = -1, _
                        Optional Compare As Long = vbBinaryCompare) As String
 
   Dim i    As Long
   Dim nPos As Long
 
   Replace = Expression
   nPos = InStr(Start, Replace, Find, Compare)
   If nPos > 0 Then
      Do
         i = i + 1
         Replace = Left$(Replace, nPos - 1) & ReplaceWith & _
                Mid$(Replace, nPos + Len(Find))
         If Count <> -1 And i >= Count Then Exit Do
         Start = nPos + Len(ReplaceWith)
         nPos = InStr(Start, Replace, Find, Compare)
      Loop While nPos > 0
   End If
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


Weblinks