VBA Helpers / vba-helpers.bas

'##########################################################################################################################################
'#
'# VBA Helpers
'# A collection of useful VBA functions
'#
'# Version 20121109.174956
'# (the version number is just the current date/time)
'#
'# Copyright (c) 2012 Christian Specht
'#
'# Visit the project site for documentation and more information:
'# http://christianspecht.de/vba-helpers/
'#
'# VBA Helpers is licensed under the MIT License.
'# See https://bitbucket.org/christianspecht/vba-helpers/raw/tip/license.txt for details.
'#
'##########################################################################################################################################

Option Compare Database
Option Explicit

Public Const vbahelpersfilename_vbah As String = "vba-helpers.bas"
Public Const vbahelpersmodulename_vbah As String = "VBAHelpers"

Const directoryseparatorchar_vbah As String = "\"
Const environmentnewline_vbah As String = vbCrLf

'##########################################################################################################################################

Public Sub File_Delete(ByVal path_vbah As String)
    'Deletes a file. If the file does not exist, nothing happens.

    If Dir(path_vbah) > "" Then
        Kill path_vbah
    End If

End Sub

Public Function File_ReadAllLines(ByVal path_vbah As String) As String()
    'Reads a text file and returns a string array, each array item containing a line from the file.
    
    Dim i_vbah As Integer
    Dim tmp_vbah As String
    Dim filelines_vbah As Long
    Dim arraylines_vbah As Long
    Dim retval_vbah() As String
    
    i_vbah = FreeFile
    Close #i_vbah
    
    Open path_vbah For Input As #i_vbah
    
    filelines_vbah = 0
    arraylines_vbah = 0
    
    Do While Not EOF(i_vbah)
        
        If arraylines_vbah <= filelines_vbah Then
            arraylines_vbah = arraylines_vbah + 100
            ReDim Preserve retval_vbah(arraylines_vbah - 1)
        End If
        
        Line Input #i_vbah, tmp_vbah
        retval_vbah(filelines_vbah) = tmp_vbah
        
        filelines_vbah = filelines_vbah + 1
        
    Loop
    
    ReDim Preserve retval_vbah(filelines_vbah - 1)
    
    Close #i_vbah
    
    File_ReadAllLines = retval_vbah
    
End Function

Public Function File_ReadAllText(ByVal path_vbah As String) As String
    'Reads a text file and returns the content in a string variable.
    
    Dim contents_vbah() As String
    
    contents_vbah = File_ReadAllLines(path_vbah)
    
    If UBound(contents_vbah) > 0 Then
        File_ReadAllText = (Join(contents_vbah, environmentnewline_vbah))
    End If

End Function

Public Sub File_WriteAllLines(ByVal path_vbah As String, contents_vbah() As String)
    'Writes the content of a string array into a text file, each array item into a new line.

    File_WriteAllText path_vbah, Join(contents_vbah, environmentnewline_vbah)

End Sub

Public Sub File_WriteAllText(ByVal path_vbah As String, ByVal contents_vbah As String)
    'Writes the content of a string variable into a text file.
    
    Dim i_vbah As Integer
    
    i_vbah = FreeFile
    
    Close #i_vbah
    
    Open path_vbah For Output As #i_vbah
    Print #i_vbah, contents_vbah
    Close #i_vbah

End Sub

Public Function Path_Combine(ParamArray paths_vbah() As Variant) As String
    'Combines several strings into a path and takes care of directory separators, i.e. `path_combine("c:\","\foo","bar")` will return `c:\foo\bar`
    
    Dim path_vbah As Variant
    Dim retval_vbah As String
    
    For Each path_vbah In paths_vbah
    
        If String_StartsWith(path_vbah, directoryseparatorchar_vbah) Then
            path_vbah = Mid(path_vbah, Len(directoryseparatorchar_vbah) + 1)
        End If
    
        If String_EndsWith(path_vbah, directoryseparatorchar_vbah) Then
            path_vbah = Left(path_vbah, Len(path_vbah) - Len(directoryseparatorchar_vbah))
        End If
    
        retval_vbah = retval_vbah & path_vbah & directoryseparatorchar_vbah
    
    Next
    
    If String_EndsWith(retval_vbah, directoryseparatorchar_vbah) Then
        retval_vbah = Left(retval_vbah, Len(retval_vbah) - Len(directoryseparatorchar_vbah))
    End If
    
    Path_Combine = retval_vbah

End Function

Public Function Path_GetCurrentDirectory() As String
    'Returns the directory of the current Access database.
    
    Path_GetCurrentDirectory = Path_GetDirectoryName(CurrentDb.Name)
    
End Function

Public Function Path_GetDirectoryName(ByVal path_vbah As String) As String
    'Receives a complete path, returns only the directory.
    
    Dim i_vbah As Long
    
    If Len(path_vbah) > 3 Then
    
        i_vbah = InStrRev(path_vbah, directoryseparatorchar_vbah)
    
        If i_vbah > 3 Then
            Path_GetDirectoryName = Left(path_vbah, i_vbah - 1)
        End If

    End If
    
End Function

Public Function Path_GetFileName(ByVal path_vbah As String) As String
    'Receives a complete path, returns only the file name.
    
    Dim i_vbah As Long
    
    i_vbah = InStrRev(path_vbah, directoryseparatorchar_vbah)
    
    If i_vbah > 0 And i_vbah < Len(path_vbah) Then
        Path_GetFileName = Mid(path_vbah, i_vbah + 1)
    End If

End Function

Public Function Path_GetFileNameWithoutExtension(ByVal path_vbah As String) As String
    'Receives a complete path, returns only the file name without extension.
    
    Dim filename_vbah As String
    Dim i_vbah As Long
    
    filename_vbah = Path_GetFileName(path_vbah)
    
    i_vbah = InStrRev(filename_vbah, ".")
    
    If i_vbah = 0 Then
        Path_GetFileNameWithoutExtension = filename_vbah
    ElseIf i_vbah > 0 Then
        Path_GetFileNameWithoutExtension = Left(filename_vbah, i_vbah - 1)
    End If
    
End Function

Public Function String_Contains(ByVal main_vbah As String, ByVal value_vbah As String) As Boolean
    'Returns `True` if the second parameter occurs within the first parameter.
    
    String_Contains = (InStr(1, main_vbah, value_vbah) > 0)
    
End Function

Public Function String_EndsWith(ByVal main_vbah As String, ByVal value_vbah As String) As Boolean
    'Returns `True` if the second parameter matches the end of the first parameter.
    
    String_EndsWith = (Right(main_vbah, Len(value_vbah)) = value_vbah)
    
End Function

Public Function String_Format(ByVal format_vbah As String, ParamArray args_vbah() As Variant)
    'Replaces numbered placeholders ({0}, {1}, ...) in the first parameter by the corresponding value from the additional parameter list.

    Dim numberofargs_vbah As Integer
    Dim i_vbah As Integer
    
    numberofargs_vbah = UBound(args_vbah)
    
    For i_vbah = 0 To 100
    
        If i_vbah <= numberofargs_vbah Then
            format_vbah = Replace(format_vbah, "{" & i_vbah & "}", args_vbah(i_vbah))
        Else
            format_vbah = Replace(format_vbah, "{" & i_vbah & "}", "")
        End If
    
    Next
    
    String_Format = format_vbah

End Function

Public Function String_PadLeft(ByVal inputstring_vbah, ByVal totalwidth_vbah, Optional ByVal paddingchar_vbah = " ")
    'Right-aligns the first string parameter by padding it on the left with the second string parameter, up to the total specified width.
    'Example: `String_PadLeft("foo",5,"a")` will return `aafoo`
    
    String_PadLeft = Right(String(totalwidth_vbah, Left(paddingchar_vbah, 1)) & inputstring_vbah, totalwidth_vbah)
    
End Function

Public Function String_PadRight(ByVal inputstring_vbah, ByVal totalwidth_vbah, Optional ByVal paddingchar_vbah = " ")
    'Left-aligns the first string parameter by padding it on the right with the second string parameter, up to the total specified width.
    'Example: `String_PadRight("foo",5,"a")` will return `fooaa`
    
    String_PadRight = Left(inputstring_vbah & String(totalwidth_vbah, Left(paddingchar_vbah, 1)), totalwidth_vbah)
    
End Function

Public Function String_StartsWith(ByVal main_vbah As String, ByVal value_vbah As String) As Boolean
    'Returns `True` if the second parameter matches the beginning of the first parameter.
    
    String_StartsWith = (Left(main_vbah, Len(value_vbah)) = value_vbah)
    
End Function

Public Function VBAHelpers_Update()
    'Updates VBA Helpers to newer version by importing a downloaded file (file must be in same folder as current Access database)
    
    Dim exportfile_vbah As String
    Dim message_vbah As String

    exportfile_vbah = Path_Combine(Path_GetCurrentDirectory, vbahelpersfilename_vbah)

    If Dir(exportfile_vbah) = "" Then
        message_vbah = String_Format("Couldn't find VBA Helpers file in current directory:{0}{1}{0}{0}VBA Helpers update failed!", vbCrLf, exportfile_vbah)
        MsgBox message_vbah, vbCritical
        Exit Function
    End If

    Application.LoadFromText acModule, vbahelpersmodulename_vbah, exportfile_vbah

End Function
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.