Função Split ( StringToArray )

Function StringToArray(textstr As String, delimiter As String) As Variant
' count is the counter for the number of array elements
Dim count As Integer
Dim ending As Integer
count = 0
'placeholder is used to mark the beginning of the string to be split
Dim placeholder As Integer
Dim splitstr As String
placeholder = 1
splitstr$ = delimiter
' txt$() is the array that will be returned
Dim txt$()
Redim txt$(0)
ending = Instr(placeholder, textstr, splitstr$)
'if ending = 0 then text does not contain a ; and the entire value should be returned
If ending = 0 Then
txt$(0) = textstr
End If
' do this until no more delimiters are found
While ending <> 0 And ending < Len(textstr) Redim Preserve txt$(count) txt$(count) = Mid$(textstr, placeholder, ending - placeholder ) count = count + 1 placeholder = ending + Len(splitstr$) ending = Instr(placeholder, textstr, splitstr$) If ending = 0 Then Redim Preserve txt$(count) txt$(count) = Mid$(textstr, placeholder, (Len(textstr)-placeholder) +1 ) End If Wend StringToArray = txt$ End Function ############################################################ ex.:call fcn_split(doc.campoA(0) + ";" + doc.campoB(0)) function fcn_split(chave As String) On Error Goto ops Dim formula As String Dim array As Variant '//gerando o array a partir da chave formula = {@Explode("} & chave & {";";")} array = Evaluate(formula) exit function #################################################### Function Split(sValue As String, sSeparador As String) As Variant '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 'Função Split(string, separador) -Transforma de uma String separada por um 'separador especifico em um Array de String do tipo Variant. ' Parâmetros: 'sValue(String) - Valores separados por um Caracter (Separador); 'sSeparador(String) - Separador que terá de ser encontrado na sValue 'Saída(Variant- Array ou String) - Se o método encontrar um separador na string, 'retornará um Array de String, senão retorna a String sem alterações. '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Dim aFile() As String Dim iCon As Integer Dim iPos As Integer Dim iPosIni As Integer Dim i As Integer iPos = Instr(sValue, sSeparador) If iPos = 0 Then Redim Preserve aFile(iPos+1) aFile(iPos) = sValue Split = aFile ' Split = sValue Else iPosIni = 1 While iPos <> 0
Redim Preserve aFile(iCon+1)
If IPos > iPosIni Then
aFile(iCon) = Mid$(sValue, iPosIni, iPos - iPosIni)
Else
aFile(iCon) = ""
End If

iPosIni = iPos+1
iPos = Instr(iPosIni, sValue, sSeparador)
iCon = iCon + 1
Wend

If iPosIni <= Len(sValue) Then Redim Preserve aFile(iCon+1) aFile(iCon) = Mid$(sValue, iPosIni, (Len(sValue) - iPosIni)+1) End If If Right$(sValue,1) <> sSeparador Then Redim Preserve aFile ( Ubound(aFile)-1)
Split = aFile
End If

End Function