Pesquisando no fórum descobri o código abaixo de autoria do Hary Shon que me atenderia perfeitamente.
Colei os códigos no meu sistema e fiz um call (VerifApostrofe) mas me dá um erro de compilação "falta identificador)
Onde está o erro ?
Public Function VerifApostrofe(Texto As String) As String
Dim TextoAux() As String, Resultado As String
Dim I As Long, TotAp As Integer
If InStr(Texto, "'") = 0 Then
VerifApostrofe = Texto
Exit Function
End If
TotAp = ItemCount(Texto, "'")
For I = 1 To TotAp
ReDim Preserve TextoAux(I)
TextoAux(I - 1) = Item(Texto, Int(I), "'")
Next
Resultado = TextoAux(0)
For I = 1 To TotAp - 1
Resultado = Resultado & "''" & TextoAux(I)
Next
VerifApostrofe = Resultado
End Function
Public Function ItemCount(Texto As String, Car As String) As Long
Dim pos As Long
Dim I As Long
I = 1
pos = 1
Do While True
pos = InStr(pos, Texto, Car)
If pos = 0 Then
If I = 1 Then I = 0
Exit Do
End If
pos = pos + 1
I = I + 1
Loop
ItemCount = I
End Function
Public Function Item(Texto As String, NrItem As Long, Separador As String) As String
Dim MyText As String
Dim Resposta As String
Dim Elem() As String
Dim I As Long
Dim pos As Long
Dim TotItens As Long
TotItens = ItemCount(Texto, Separador)
If TotItens = 0 Or _
NrItem > TotItens Then
Resposta = Texto
Else
MyText = Texto
ReDim Elem(TotItens)
For I = 1 To TotItens
pos = InStr(MyText, Separador)
If pos <> 0 Then
pos = (pos - 1) + Len(Separador)
Elem(I - 1) = Left(MyText, pos)
If InStr(Elem(I - 1), Separador) <> 0 Then
Elem(I - 1) = Left(Elem(I - 1), Len(Elem(I - 1)) - Len(Separador))
End If
MyText = Right(MyText, Len(MyText) - pos)
Else
Elem(I - 1) = MyText
End If
If I = NrItem Then Exit For
Next
Resposta = Elem(NrItem - 1)
End If
Item = Resposta
End Function
Colei os códigos no meu sistema e fiz um call (VerifApostrofe) mas me dá um erro de compilação "falta identificador)
Onde está o erro ?
Public Function VerifApostrofe(Texto As String) As String
Dim TextoAux() As String, Resultado As String
Dim I As Long, TotAp As Integer
If InStr(Texto, "'") = 0 Then
VerifApostrofe = Texto
Exit Function
End If
TotAp = ItemCount(Texto, "'")
For I = 1 To TotAp
ReDim Preserve TextoAux(I)
TextoAux(I - 1) = Item(Texto, Int(I), "'")
Next
Resultado = TextoAux(0)
For I = 1 To TotAp - 1
Resultado = Resultado & "''" & TextoAux(I)
Next
VerifApostrofe = Resultado
End Function
Public Function ItemCount(Texto As String, Car As String) As Long
Dim pos As Long
Dim I As Long
I = 1
pos = 1
Do While True
pos = InStr(pos, Texto, Car)
If pos = 0 Then
If I = 1 Then I = 0
Exit Do
End If
pos = pos + 1
I = I + 1
Loop
ItemCount = I
End Function
Public Function Item(Texto As String, NrItem As Long, Separador As String) As String
Dim MyText As String
Dim Resposta As String
Dim Elem() As String
Dim I As Long
Dim pos As Long
Dim TotItens As Long
TotItens = ItemCount(Texto, Separador)
If TotItens = 0 Or _
NrItem > TotItens Then
Resposta = Texto
Else
MyText = Texto
ReDim Elem(TotItens)
For I = 1 To TotItens
pos = InStr(MyText, Separador)
If pos <> 0 Then
pos = (pos - 1) + Len(Separador)
Elem(I - 1) = Left(MyText, pos)
If InStr(Elem(I - 1), Separador) <> 0 Then
Elem(I - 1) = Left(Elem(I - 1), Len(Elem(I - 1)) - Len(Separador))
End If
MyText = Right(MyText, Len(MyText) - pos)
Else
Elem(I - 1) = MyText
End If
If I = NrItem Then Exit For
Next
Resposta = Elem(NrItem - 1)
End If
Item = Resposta
End Function