Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Strings Code Examples

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

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
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