Visual Basic Programming Code Examples

Visual Basic > Strings Code Examples

Convert an array to a string and a string to an array

Convert an array to a string and a string to an array

The following routines are useful when converting an array to string or a string to array.

Option Explicit

'Purpose   :    Converts a 1d or 2d array to a deliminated String
'Inputs    :    avInArray                       The array to convert to a string
'               sDelimRows                      Delimeter to seperate rows
'               sDelimCols                      Delimeter to seperate columns (for 2d arrays)
'Outputs   :    A string containing all the elements of avInArray seperated by sDelimRows
'Notes     :

Function ArrayToString(avInArray As Variant, Optional sDelimRows As String = "�", Optional sDelimCols As String = "�") As String
    Dim lThisItem As Long, lNumItems As Long, lFirstRow As Long, lLastRow As Long
    Dim lThisRow As Long, lThisCol As Long, lFirstCol As Long, lLastCol As Long
    
    On Error GoTo ExitProc
    Select Case ArrayNumDimensions(avInArray)
    Case 0
        'Empty array
    Case 1
        '1D Array
        For lThisItem = LBound(avInArray) To UBound(avInArray)
            ArrayToString = ArrayToString & (CStr(avInArray(lThisItem)) & sDelimRows)                     'Join the small to the large
        Next
    Case 2
        '2D Arrays
        lFirstRow = LBound(avInArray, 2)
        lLastRow = UBound(avInArray, 2)
        lFirstCol = LBound(avInArray, 1)
        lLastCol = UBound(avInArray, 1)
        'Loop over each column then row to create the result string
        For lThisCol = lFirstCol To lLastCol
            For lThisRow = lFirstRow To lLastRow
                ArrayToString = ArrayToString & (CStr(avInArray(lThisCol, lThisRow)) & sDelimRows)       'Join the small to the large
            Next
            ArrayToString = ArrayToString & sDelimCols
        Next
    Case Else
        MsgBox "ArrayToString: Invalid array structure"
    End Select

ExitProc:
    On Error GoTo 0
End Function

'Purpose   :    Converts a string to string array.
'Inputs    :    sThisString                     The string to convert to an array
'               asResults                       String array containing results
'               sDelimRows                      Delimeter to seperate rows
'               sDelimCols                      Delimeter to seperate columns (for 2d arrays)
'Outputs   :    N/A
'Notes     :
'Revisions :

Sub StringToArray(ByVal sThisString As String, asResults() As String, Optional sDelimRows As String = "�", Optional sDelimCols As String = "�")
    Dim lPos1dDel As Long, lPos2dDel As Long, lLenString As Long, lColSepLen As Long
    Dim lLastPos As Long, lNumCols As Long, lThisRow As Long, lThisCol As Long, lRowSepLen As Long
    
    lLenString = Len(sThisString)
    
    If lLenString Then
        lLastPos = 1
        lPos1dDel = InStr(1, sThisString, sDelimRows)
        lPos2dDel = InStr(1, sThisString, sDelimCols)
        lNumCols = StringCount(sThisString, sDelimCols, vbTextCompare)
        lRowSepLen = Len(sDelimRows)
        
        If lNumCols Then
            'Convert a 2d string
            lThisCol = 1
            lColSepLen = Len(sDelimCols)
            'Create buffer to store results
            On Error GoTo 0
            ReDim asResults(1 To lNumCols, 1 To Int(lLenString / 2))
            Do While lPos1dDel
                lThisRow = lThisRow + 1
                If lPos1dDel > lPos2dDel Then
                    'Next Column
                    lThisCol = lThisCol + 1
                    lThisRow = 0
                    lPos2dDel = InStr(lPos2dDel + 1, sThisString, sDelimCols)
                    lLastPos = lLastPos + lColSepLen
                Else
                    'Store Row
                    asResults(lThisCol, lThisRow) = Mid$(sThisString, lLastPos, lPos1dDel - lLastPos)
                    lLastPos = lPos1dDel + lRowSepLen
                End If
                lPos1dDel = InStr(lLastPos, sThisString, sDelimRows)
            Loop
            ReDim Preserve asResults(1 To lNumCols, 1 To lThisRow)
        Else
            'Convert a 1d string
            'Create buffer to store results
            ReDim asResults(1 To Int(lLenString / 2))
            lPos1dDel = InStr(lLastPos, sThisString, sDelimRows)
            Do While lPos1dDel
                lThisRow = lThisRow + 1
                asResults(lThisRow) = Mid$(sThisString, lLastPos, lPos1dDel - lLastPos)
                lLastPos = lPos1dDel + lRowSepLen
                lPos1dDel = InStr(lLastPos, sThisString, sDelimRows)
            Loop
            ReDim Preserve asResults(1 To lThisRow)
        End If
    Else
        Erase asResults
    End If
End Sub

'Purpose   :    Calculates the number of dimensions in an array
'Inputs    :    avInArray. The array to evaluate.
'Outputs   :    The number of dimensions the array has.
'Notes     :

Function ArrayNumDimensions(avInArray As Variant) As Long
    Dim lNumDims As Long
    
    If IsArray(avInArray) Then
        On Error GoTo ExitSub
        Do
            lNumDims = UBound(avInArray, ArrayNumDimensions + 1)
            ArrayNumDimensions = ArrayNumDimensions + 1
        Loop
    End If
    
ExitSub:
    On Error GoTo 0
End Function

'Purpose     :  Count the number of matching instances of one string within another
'Inputs      :  sSearchString                       The string to search
'               sForItem                            The string to search for
'               [tCompare]                          The method of comparison. Defaults to a case insensative search.
'                                                   Can also specify vbBinaryCompare.
'Outputs     :  Returns the number of instances of the sForItem within sSearchString
'Notes       :
'Revisions   :
 
Function StringCount(sSearchString As String, sForItem As String, Optional tCompare As Long = vbTextCompare) As Long
    Dim lPos As Long, lLenItem As Long
    
    lLenItem = Len(sForItem)
    Do
        lPos = InStr(lPos + lLenItem, sSearchString, sForItem, tCompare)
        If lPos Then
            StringCount = StringCount + 1
        Else
            Exit Do
        End If
    Loop
End Function