Tipps und Tricks zu VBA

Lies diesen Artikel und viele weitere mit einem kostenlosen, einwöchigen Testzugang.

Autor: Christoph Spielmann, Düsseldorf

Auf den folgenden Seiten versorgen wir Sie mit einigen Tipps und Tricks rund um VBA, die Sie sofort in Betrieb nehmen können. Hier finden Sie beispielsweise eine Möglichkeit, Zeichenketten innerhalb von Zeichenketten zu deklarieren, und lernen, die Dateiendung einer Datei zu ermitteln. Wenn Sie schon einmal mit dem Vergleich von Datumswerten zu kämpfen hatten, finden Sie hier ebenfalls eine Lösung. Diese und weitere nachfolgend beschriebene Tipps und Tricks für alltäglich auftretende Probleme legen Sie am besten griffbereit in Reichweite des PCs – Sie werden sie gut gebrauchen können.

Die Verwendung des doppelten Anführungszeichens “ (Ascii-Zeichencode 34) im Code bereitet ein paar kleine Schwierigkeiten. String-Literale (Klartext-Strings) müssen selbst bereits in Anführungszeichen eingeschlossen werden.

Public Function AddQuotes(Text As String, Optional _  ByVal AddQuotesMode As AddQuotesModeConstants) _  As String
  Dim nLeftQuotes, nRightQuotes, nQuotes As Long
  Select Case AddQuotesMode
    Case aqForce: AddQuotes = vbQuote & Text & vbQuote
    Case aqToPairs
      nLeftQuotes = zGetLeftQuotes(Text)
      nRightQuotes = zGetRightQuotes(Text)
      If nLeftQuotes Or nRightQuotes Then
        nQuotes = nLeftQuotes - nRightQuotes
        Select Case Sgn(nQuotes)
          Case -1: AddQuotes = _            String(Abs(nQuotes), 34) & Text
          Case 0: AddQuotes = Text
          Case 1: AddQuotes = Text & String(nQuotes, 34)
        End Select

Daher kann das Anführungszeichen nicht so einfach innerhalb eines String-Literals verwendet werden. Es ist zu verdoppeln:

Text = "Hallo ""Welt""!"

Wenn Sie ein einzelnes Anführungszeichen einer Variablen zuweisen oder es als Parameter übergeben wollen, sieht das in dieser Schreibweise etwas verwirrend aus:

Anführungszeichen = """"

Sie können natürlich in solchen Fällen auch die Chr$-Funktion verwenden, um das Anführungszeichen anhand des Ascii-Codes zu erhalten, wie folgendes Beispiel zeigt:

Anführungszeichen = Chr$(34)
      Else
        AddQuotes = vbQuote & Text & vbQuote
      End If
    Case aqEnsureSinglePair
      nLeftQuotes = zGetLeftQuotes(Text)
      nRightQuotes = zGetRightQuotes(Text)
      Select Case nLeftQuotes
        Case 0:
          Select Case nRightQuotes
            Case 0: AddQuotes = vbQuote & Text & vbQuote
            Case 1: AddQuotes = vbQuote & Text
            Case Else: AddQuotes = vbQuote & _              Left$(Text, Len(Text) - nRightQuotes + 1)
          End Select
        Case 1
          Select Case nRightQuotes:
            Case 0: AddQuotes = Text & vbQuote
            Case 1: AddQuotes = Text
            Case Else: AddQuotes = _              Left$(Text, Len(Text) - nRightQuotes + 1)
          End Select
      Case Else
        Select Case nRightQuotes
          Case 0: AddQuotes = _            Mid$(Text, nLeftQuotes) & vbQuote
          Case 1: AddQuotes = Mid$(Text, nLeftQuotes)
          Case Else: AddQuotes = Mid$(Text, _            nLeftQuotes, Len(Text) - nRightQuotes)
        End Select
      End Select
  End Select
End Function
Public Function StripQuotes(Text As String, _
  Optional ByVal StripQuotesMode As _  StripQuotesModeConstants) As String
  Dim nLeftQuotes, nRightQuotes, nQuotes As Long
  Select Case StripQuotesMode
    Case sqAll
      nLeftQuotes = zGetLeftQuotes(Text)
      nRightQuotes = zGetRightQuotes(Text)
      StripQuotes = Mid$(Text, nLeftQuotes + 1, _        Len(Text) - nLeftQuotes - nRightQuotes)
    Case sqAllPairs
      nLeftQuotes = zGetLeftQuotes(Text)
      nRightQuotes = zGetRightQuotes(Text)

Quellcode 2 (Teil 1)

Diese Schreibweise ist jedoch eher umständlich. Eine Konstante im üblichen Stil der Visual Basic-Konstanten ist erheblich einfacher und auch leichter lesbar.

Allerdings können Sie Konstanten nicht per Funktion erzeugen – folgende Konstanten-Deklaration würde vom Kompiler nicht akzeptiert:

Public Const vbQuote = _    Chr$(34)

Wenn Sie eine Anführungszeichenkonstante wie folgt in einem Standardmodul deklarieren, benötigen Sie die verwirrende Schreibweise mit den vier aufeinanderfolgenden Anführungszeichen nur ein einziges Mal:

Public Const vbQuote = _    """"

Da Anführungszeichen zumeist paarweise verwendet werden, ist es recht praktisch, das Hinzufügen oder Entfernen von Anführungszeichen-Paaren in Hilfsfunktionen zu packen.

Die Funktion AddQuotes (s. Quellcode 1) fügt Anführungszeichen zu einem gegebenen String hinzu.

Im optionalen Parameter AddQuotesMode können Sie festlegen, ob ein Anführungszeichen-Paar in jedem Fall hinzugefügt werden soll (aqForce, Voreinstellung) oder ob eine ungleiche Anzahl von Anführungszeichen am Anfang und am Ende des betreffenden Strings zu Paaren aufgefüllt werden soll (aqToPairs).

      Select Case nLeftQuotes
        Case Is >= nRightQuotes
          nQuotes = nRightQuotes
        Case Else
          nQuotes = nLeftQuotes
      End Select
      StripQuotes = Mid$(Text, nQuotes + 1, _        Len(Text) - 2 * nQuotes)
    Case sqSinglePair
      If Left$(Text, 1) = vbQuote And _        Right$(Text, 1) = vbQuote Then
        StripQuotes = Mid$(Text, 2, Len(Text) - 2)
      End If
  End Select
End Function

Quellcode 2 (Teil 2)

Private Function zGetLeftQuotes(Text As String) As Long
  Dim nLeftQuotes, nPos, nStart As Long
  nStart = 1
  Do
    nPos = InStr(nStart, Text, vbQuote)
    If nPos = nStart Then
      nLeftQuotes = nLeftQuotes + 1
      nStart = nStart + 1
    Else
      zGetLeftQuotes = nLeftQuotes
      Exit Function
    End If
  Loop
End Function

Quellcode 3

Private Function zGetRightQuotes(Text As String) As Long
  Dim nRightQuotes, nPos, nStart As Long
  nStart = Len(Text)
  Do
    nPos = InStrRev(Text, vbQuote, nStart)
    If nPos = nStart Then
      nRightQuotes = nRightQuotes + 1
      nStart = nStart - 1
    Else
      zGetRightQuotes = nRightQuotes
      Exit Function
    End If
  Loop
End Function

Quellcode 4

Den dritten Parameter verwenden Sie, wenn sichergestellt werden soll, dass der im String enthaltene Text von genau einem Anführungszeichen-Paar eingeschlossen wird.

Dazu legen Sie zunächst einmal die möglichen Parameter fest, mit denen der Benutzer die Funktion aufrufen kann:

Public Enum _ AddQuotesModeConstants

aqForce

aqToPairs

aqEnsureSinglePair

End Enum

Die Hilfs-Funktion StripQuotes (s. Quellcode 2) bietet Ihnen ebenfalls mehrere Möglichkeiten. Hier geben Sie im optionalen Parameter StripQuotesMode an, ob alle einschließenden Anführungszeichen entfernt werden sollen, ob alle Paare entfernt werden sollen oder ob genau ein Paar entfernt werden soll.

Auch für den Betrieb dieser Funktion definieren Sie zunächst einen Satz von Konstanten, die als Parameter neben dem zu bearbeitenden String übergeben werden sollen:

Public Enum _  StripQuotesModeConstants
  sqAll
  sqAllPairs
  sqSinglePair
End Enum

Beide Funktionen ermitteln in den meisten Fällen erst einmal die vorhandene Anzahl der links- und rechtsseitigen Anführungszeichen über die privaten Hilfs-Funktionen zGetLeftQuotes (s. Quellcode 3) und zGetRightQuotes (s. Quellcode 4). Dies reduziert deutlich die Anzahl der anfallenden einzelnen String-Operationen, die relativ langsam wären.

Private Function GetFileExtension(Path As String) _    As String
    Dim nPosDot As Long
    nPosDot = InStrRev(Path, ".")
    If nPosDot Then
        If InStrRev(Path, "\") < nPosDot Then
            GetFileExtension = Mid$(Path, nPosDot + 1)
        End If
    End If
End Function

Quellcode 5

Private Function GetFileExtension5(Path As String) _
    As String
    Dim I, nPosDot, nPosBS, nStart As Integer
    Do
        nPosDot = InStr(nStart + 1, Path, ".")
        If nPosDot Then
            nStart = nPosDot
        Else
            nPosDot = nStart
            Exit Do
        End If
    Loop
    nStart = 0
    Do
        nPosBS = InStr(nStart + 1, Path, "\")
        If nPosBS Then
            nStart = nPosBS
        Else
            nPosBS = nStart
            Exit Do
        End If
    Loop
    If nPosDot Then
        If nPosBS < nPosDot Then
            GetFileExtension5 = Mid$(Path, nPosDot + 1)
        End If
    End If
End Function

Quellcode 6

Das Extrahieren der Dateierweiterung (Extension) einer Datei sollte an sich recht einfach sein: Sie beginnt hinter dem letzten Punkt im Dateinamen. Enthält der Dateiname keinen Punkt, hat die Datei auch keine Erweiterung. Solange es sich um einen Dateinamen ohne Pfadteile handelt, können Sie diesen letzten Punkt problemlos vom Ende einer Datei her ausfindig machen und aus dem Antreffen eines Punkts auf das Vorhandensein einer Dateierweiterung schließen.

Sobald Sie es jedoch mit einem ganzen Pfad zu tun haben, funktioniert dies nicht mehr zuverlässig. Denn falls einer der übergeordneten Pfadbestandteile selbst eine Erweiterung hat und die Datei am Ende bzw. der letzte Pfad nicht erweitert ist, würde so der gesamte Teil ab dem gefundenen letzten Punkt als Dateierweiterung betrachtet, bestehend aus der Erweiterung dieses Pfadbestandteils und aus allen nachfolgenden Pfadbestandteilen. Zum Beispiel ergäbe der Pfad:

c:\abc.def\ghi\jkl

als Dateierweiterung:

def\ghi\jkl

Zu einem korrekten Ergebnis gelangen Sie, wenn Sie zunächst sowohl die Position des letzten Punktes als auch die des letzten Backslashs ermitteln. Dann prüfen Sie, falls überhaupt ein Punkt gefunden wurde, ob die Position des letzten Backslash kleiner als die des letzten Punktes ist – nur dann markiert der Punkt den Beginn der Dateierweiterung des letzten Pfadbestandteils.

Public Function IsSameMonth (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameMonth = Not CBool(DateDiff("m", Date1, Date2))
End Function

Quellcode 7

Public Function IsSameQuarter (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameQuarter = _        Not CBool(DateDiff("q", Date1, Date2))
End Function
Public Function IsSameWeek (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameWeek = Not CBool(DateDiff("w", Date1, Date2))
End Function
Public Function IsSameDay (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameDay = Not CBool(DateDiff("d", Date1, Date2))
End Function
Public Function IsSameHour (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameHour = Not CBool(DateDiff("h", Date1, Date2))
End Function
Public Function IsSameMinute (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameMinute = Not CBool(DateDiff("n", Date1, _        Date2))
End Function
Public Function IsSameSecond (ByVal Date1 As Date, _    ByVal Date2 As Date) As Boolean
    IsSameSecond = Not CBool(DateDiff("s", Date1, _        Date2))
End Function

Quellcode 8

Ab VBA6 (Access 2000) können Sie zur Ermittlung der jeweils letzten Positionen die Funktion InStrRev verwenden, wie die Funktion aus Quellcode 5 zeigt.

In früheren VBA-Versionen steht die Funktion InStrRev noch nicht zur Verfügung – Sie können stattdessen eine eigene Implementierung der Erweiterungssuche mit einer schnellen, von vorne beginnenden Suche auf der Basis der InStr-Funktion verwenden. Sie finden diese Funktion in Quellcode 6.

Ob es sich bei zwei Datumsangaben um den gleichen Monat handelt, scheint auf den ersten Blick klar zu sein:

Ende des frei verfügbaren Teil. Wenn Du mehr lesen möchtest, hole Dir ...

Testzugang

eine Woche kostenlosen Zugriff auf diesen und mehr als 1.000 weitere Artikel

diesen und alle anderen Artikel mit dem Jahresabo

Schreibe einen Kommentar