Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Modules (VBA Coding) FAQ


Access 2000-compatible functions for Access 97 by RickSpr
Posted: 23 Oct 03

Microsoft added a number of handy functions to Access 2000 (VBA version 6). So handy, in fact, that I wanted to use them in Access 97, so I wrote compatible VBA5 versions of some of them. This also allows me to write code that runs identically in Access 97 and Access 2000, but still takes advantage of the built-in functions when imported into Access 2000.

I keep all these functions in a module called "VBA6 Functions" in one of my library databases. Then I can simply import the module and delete any functions I don't need.

' Application: Various
' Module:      VBA6 Functions
' Version:     11/16/01 14:00
' Description:
' This module contains VBA version 5 implementations of built-in functions that were
' new in VBA version 6. Care was taken when writing this code to preserve the
' precedence of error detection, so parameter errors should raise the same runtime
' errors as in VBA6.
' One thing that could not be duplicated, due to language differences, is enumerated
' parameter types. For example, in InStrRev, the 4th parameter should have been of
' type VbCompareMethod, but VBA5 does not allow us to have this enumerated type of
' parameter in our own code. In all cases, a compatible basic data type was used.
' This means that the Object Browser and AutoQuickInfo syntax tips are  not identical
' to VBA6, and the AutoListMembers feature will not work with these parameters.
' Modification history:
' 11/16/01 14:00 RPS Fixed a bug in Join

Option Compare Database
Option Explicit

' The following conditional compilation statement prevents this code from being
' compiled if this module should be imported into Access 2000 by mistake.
#If Not CBool(Vba6) Then

Public Function InStrRev(StringCheck As String, StringMatch As String, _
                         Optional Start As Long = -1, _
                         Optional Compare As Integer = vbBinaryCompare) _
                         As Long
' Purpose: Finds the last occurrence of a substring within a string
' Accepts: 1. String to be searched
'          2. Substring whose occurrence is to be found
'          3. Optional rightmost position to be searched (default is
'             -1, meaning to search the entire string)
'          4. Optional text comparison method (default: binary compare)
' Returns: Position of the substring within the string (1=start of string)
' Notes:   Returns 0 if the string to be search is zero-length.
'          Returns Start if the string to be found is zero-length.
'          Returns 0 if Start is past the end of the search string.
'          Returns 0 if substring is not found.
    Dim i As Long, j As Long, k As Long, S As String

    If (Start < -1) Or (Start = 0) Then Error 5
    j = Len(StringCheck)
    k = Len(StringMatch)
    i = Start
    If i = -1 Then i = j
    If j = 0 Then InStrRev = 0: Exit Function
    If k = 0 Then InStrRev = i: Exit Function
    If i > j Then InStrRev = 0: Exit Function
    S = Left$(StringCheck, i)
    i = 0
        j = InStr(i + 1, S, StringMatch, Compare)
        If j = 0 Then Exit Do
        i = j
    InStrRev = i
End Function

Public Function Replace(Expression As String, _
                        Find As String, ByVal ReplaceWith As String, _
                        Optional Start As Long = 1, Optional Count As Long = -1, _
                        Optional Compare As Integer = vbBinaryCompare) As String
' Purpose: Replaces occurrences of a substring within a string with a specified
'          repacement string.
' Accepts: 1. String containing substrings to be replaced
'          2. Value of the substring to be found
'          3. Replacement value to substitute for the substring
'          4. Optional starting position for the search, default=1 (start of string)
'          5. Optional maximum number of occurrences to replace, default=-1 (all
'             occurences)
'          6. Optional text comparison method (default: binary compare)
' Returns: The part of the string starting at the Start position, with substitutions
'          made. Returns an empty string if Start > Len(Expression).
    Dim str As String
    Dim i As Long
    Dim lngFindLen As Long
    Dim c As Long
    If Start < 1 Then Err.Raise 5
    If Count < -1 Then Err.Raise 5
    If Compare < 0 Or Compare >= 40 Then Err.Raise 5
    str = Mid$(Expression, Start)
    lngFindLen = Len(Find)
    If lngFindLen > 0 Then
        c = Count
        i = 1
        Do While c <> 0
            i = InStr(i, str, Find, Compare)
            If i = 0 Then Exit Do
            If lngFindLen = Len(ReplaceWith) Then
                Mid$(str, i, lngFindLen) = ReplaceWith
                str = Left$(str, i - 1) & ReplaceWith & Mid$(str, i + lngFindLen)
            End If
            i = i + Len(ReplaceWith)
            If c > 0 Then c = c - 1
    End If
    Replace = str
End Function

Public Function Join(SourceArray As Variant, Optional Delimiter As Variant) As String
' Purpose: Create a string containing the elements of an array separated by a
'          delimiter character.
' Accepts: 1. A variant array containing any data that can be converted to strings.
'             Different elements can be of different types. The array can be empty.
'          2. A delimiter to be inserted between the strings. This also must be
'             convertible to a string. It is usually a single-character string.
    Dim delim As String
    Dim item As String, result As String
    Dim i As Integer, top As Integer
    ' if SourceArray is not a variant (array), raise error 13
    If VarType(SourceArray) And vbArray = 0 Then Err.Raise 13
    ' set the default delimiter
    If IsMissing(Delimiter) Then
        delim = " "
        delim = CStr(Delimiter)
    End If
    ' concatenate the array entries
    On Error GoTo ErrorHandler
    ' Note: If the array is empty, the next statement raises error 9
    top = UBound(SourceArray)
    For i = LBound(SourceArray) To top
        On Error GoTo 0
        ' if variant type is array or Object, raise error 13
        If (VarType(SourceArray(i)) And vbArray) <> 0 Then Err.Raise 13
        If (VarType(SourceArray(i)) = vbObject) Then Err.Raise 13
        result = result & CStr(SourceArray(i))
        If i < top Then result = result & delim
    Next i
    Join = result
    Exit Function
    If Err.Number = 9 Then Resume ErrorResume
    Err.Raise Err.Number
End Function

Public Function Split(Expression As String, Optional Delimiter, _
                      Optional Limit As Long = -1, _
                      Optional Compare As Integer = vbBinaryCompare) As Variant
' Purpose: Split a string into substrings at a delimiter, and return the substrings
'          in a Variant (Array of String)
' Accepts: 1. String expression to be split
'          2. Optional delimiter (default is ' ')
'          3. Optional maximum of number of substrings to return (default is all
'             substrings)
'          4. Optional compare mode for delimiter (default is case-sensitive)
' Returns: Variant array of strings containing substrings separated by the delimiter.
'          If Limit is reached, last entry in array contains remainder of string,
'          including any delimiters embedded.
    Dim result()
    Dim i As Integer, j As Integer, Count As Integer
    If Limit < -1 Then Err.Raise 5
    If IsMissing(Delimiter) Then Delimiter = " "
    If Delimiter = "" Then
        ReDim result(0)
        result(0) = Expression
        Split = result
        Exit Function
    End If
    If Expression = "" Then
        Split = Array()
        Exit Function
    End If
    i = 1
        If (Limit >= 0) And (Count >= Limit - 1) Then Exit Do
        j = InStr(i, Expression, Delimiter, Compare)
        If j = 0 Then Exit Do
        ReDim Preserve result(Count)
        result(Count) = Mid$(Expression, i, j - i)
        Count = Count + 1
        i = j + Len(Delimiter)
    ReDim Preserve result(Count)
    result(Count) = Mid$(Expression, i)
    Split = result
End Function

Public Function StrReverse(Expression As String) As String
' Purpose: Returns a string in which the character sequence is reversed from that of
'          the parameter.
    Dim i As Integer, j As Integer, S As String
    S = Expression
    i = 1
    For j = Len(S) To 1 Step -1
        Mid$(S, i, 1) = Mid$(Expression, j, 1)
        i = i + 1
    Next j
    StrReverse = S
End Function

Public Function MonthName(Month As Long, Optional Abbreviate As Boolean = False) _
    As String
' Purpose: Returns a string indicating the specified month.
' Accepts: The month number (1-12). Optionally, an indicator to abbreviate the
'          returned name.
' Returns: The month name as a string. If Abbreviate=True, the string is abbreviated
'          to the first three characters.
' Note:    Unlike the standard VBA6 function, this function does NOT return the
'          month name in the local language. The returned month name is always
'          English.
    Dim astrMonthName As Variant
    If (Month < 1) Or (Month > 12) Then Err.Raise 5
    astrMonthName = Array("January", "February", "March", "April", "May", "June", _
        "July", "August", "September", "October", "November", "December")
    If Abbreviate Then
        MonthName = Left$(astrMonthName(Month), 3)
        MonthName = astrMonthName(Month)
    End If
End Function

#End If

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close