• Home
 · 
• String Manipulation
 · 
• Various functions related to trim(). The difference is that you can trim a string for newline chara

Various functions related to trim(). The difference is that you can trim a string for newline chara

Various functions related to trim(). The difference is that you can trim a string for newline characters, whitespace or any character you wish.

API Declarations



' Trim functions
' jjo 2002





Rate Various functions related to trim(). The difference is that you can trim a string for newline chara

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

                         ByVal fjern As String, _
                         Optional OptComp As Integer = 0) As String

    If ((Len(s) = 0) Or (Len(fjern) = 0)) Then
        LTrimChr = s: Exit Function
    End If

    Dim idx As Long

    fjern = Left(fjern, 1)

    For idx = 1 To Len(s)
        If (StrComp(Mid(s, idx, 1), fjern, OptComp) <> 0) Then Exit For
    Next

    LTrimChr = Mid(s, idx)

End Function

Public Function RTrimChr(ByVal s As String, _
                         ByVal fjern As String, _
                         Optional OptComp As Integer = 0) As String

    If ((Len(s) = 0) Or (Len(fjern) = 0)) Then
        RTrimChr = s: Exit Function
    End If

    Dim idx As Long

    fjern = Left(fjern, 1)

    For idx = Len(s) To 1 Step -1
        If (StrComp(Mid(s, idx, 1), fjern, OptComp) <> 0) Then Exit For
    Next

    RTrimChr = Mid(s, 1, idx)

End Function

Public Function TrimChr(s As String, _
                        tegn As String, _
                        Optional OptComp As Integer = 0) As String

    TrimChr = LTrimChr(RTrimChr(s, tegn, OptComp), tegn, OptComp)

End Function

Public Function LTrimChr2(ByVal s As String, _
                          ByVal chr1 As String, _
                          ByVal chr2 As String, _
                          Optional OptComp As Integer = 0) As String

    If ((Len(s) = 0) Or ((Len(chr1) = 0) Or (Len(chr2) = 0))) Then
        LTrimChr2 = s: Exit Function
    End If

    Dim c As String, idx As Long

    chr1 = Left(chr1, 1)
    chr2 = Left(chr2, 1)

    For idx = 1 To Len(s)
        c = Mid(s, idx, 1)
        If (StrComp(c, chr1, OptComp) <> 0) And _
           (StrComp(c, chr2, OptComp) <> 0) Then
            Exit For
        End If
    Next
    
    LTrimChr2 = Mid(s, idx)

End Function

Public Function RTrimChr2(ByVal s As String, _
                          ByVal chr1 As String, _
                          ByVal chr2 As String, _
                          Optional OptComp As Integer = 0) As String

    If ((Len(s) = 0) Or ((Len(chr1) = 0) Or (Len(chr2) = 0))) Then
        RTrimChr2 = s: Exit Function
    End If

    Dim c As String, idx As Long

    chr1 = Left(chr1, 1)
    chr2 = Left(chr2, 1)

    For idx = Len(s) To 1 Step -1
        c = Mid(s, idx, 1)
        If (StrComp(c, chr1, OptComp) <> 0) And _
           (StrComp(c, chr2, OptComp) <> 0) Then
            Exit For
        End If
    Next

    RTrimChr2 = Mid(s, 1, idx)

End Function

Public Function TrimChr2(s As String, _
                         chr1 As String, _
                         chr2 As String, _
                         Optional OptComp As Integer = 0) As String

    TrimChr2 = LTrimChr2(RTrimChr2(s, chr1, chr2, OptComp), chr1, chr2, OptComp)

End Function

Public Function LTrimLF(s As String) As String

    LTrimLF = LTrimChr(s, Chr$(10), 0)

End Function

Public Function RTrimLF(s As String) As String

    RTrimLF = RTrimChr(s, Chr$(10), 0)

End Function

'Line feed
'vbLf: chr(10)
Public Function TrimLF(s As String) As String

    TrimLF = LTrimLF(RTrimLF(s))

End Function

Public Function LTrimCR(s As String) As String

    LTrimCR = LTrimChr(s, Chr$(13), 0)

End Function

Public Function RTrimCR(s As String) As String

    RTrimCR = RTrimChr(s, Chr$(13), 0)

End Function

'Carriage return
'vbCr: chr(13)
Public Function TrimCR(s As String) As String

    TrimCR = LTrimCR(RTrimCR(s))

End Function

Public Function LTrimNL(s As String) As String

    LTrimNL = LTrimChr2(s, Chr(10), Chr(13), 0)

End Function

Public Function RTrimNL(s As String) As String

    RTrimNL = RTrimChr2(s, Chr(10), Chr(13), 0)

End Function

'New line
'vbLf  :  chr(10)
'vbCr  :  chr(13) and vbCrLf
Public Function TrimNL(s As String) As String

    TrimNL = LTrimNL(RTrimNL(s))

End Function

Public Function LTrimWS(s As String) As String

    LTrimWS = LTrimChr2(s, Chr$(9), Chr$(32), 0)

End Function

Public Function RTrimWS(s As String) As String

    RTrimWS = RTrimChr2(s, Chr$(9), Chr$(32), 0)

End Function

'White space
'Tab   : chr(9)
'Space : chr(32)
Public Function TrimWS(s As String) As String

    TrimWS = LTrimWS(RTrimWS(s))

End Function

Public Function LTrimPATH(s As String) As String

    LTrimPATH = LTrimChr2(s, "/", "\", 0)

End Function

Public Function RTrimPATH(s As String) As String

    RTrimPATH = RTrimChr2(s, "/", "\", 0)

End Function

'Path separators
Public Function TrimPATH(s As String) As String

    TrimPATH = LTrimPATH(RTrimPATH(s))

End Function

Sub TrimWS_test()

    Dim a As String, b As String, c As Integer
    
    b = vbTab & Space(1)
    For c = 1 To 4: b = b & b: Next
    a = b & "_" & b
    
    MsgBox "'" & TrimWS(a) & "'", 0, "TrimWS()"
    'MsgBox a, 0, ""
    
End Sub

Sub TrimPATH_test()

    Dim a As String, b As String, c As Integer
    
    b = "\/"
    For c = 1 To 4: b = b & b: Next
    a = b & "_" & b
    
    MsgBox "'" & TrimPATH(a) & "'", 0, "TrimPATH()"
    'MsgBox a, 0, ""
    
End Sub

Sub TrimNL_test()

    Dim a As String, b As String, c As Integer
    
    b = vbLf & vbCr & vbCrLf
    For c = 1 To 2: b = b & b: Next
    a = b & "_" & b
    
    MsgBox "'" & TrimNL(a) & "'", 0, "NewLine"
    'MsgBox "'" & a & "'", 0, ""
    
End Sub

Sub TrimChr_test()

    Dim a As String, b As String, c As Integer
    b = "qQ"
    For c = 1 To 4: b = b & b: Next
    a = b & "_" & b

    MsgBox "'" & TrimChr(a, "q", 1) & "'", 0, "TrimChr()"
    'MsgBox a, 0, ""

End Sub