Verificação de Apóstrofe em nomes próprios

Quem ja se deparou com algum erro no salvamento, copia ou mesmo leitura de Nomes Próprios que contenha um Apóstrofe?

Exemplo: João D'Abadia

Esse erro pode acontecer porque o codigo não reconhece o Apóstrofo como válido, deixando de executar o Updade ou exclusão ou outra operação que contenha o referido sinal


Em um módulo:

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


Aqui a parte de um código onde foi aplicada a solução:


****Neste código faço a exclusão de fotos relacionadas a uma pessoa, que contem caminho na tabela e a foto com o nome dentro de uma referida pasta, observe a colocação da função que verifica o Apóstrofe no código



Private Sub DelFoto(mFoto)
Dim mDir As String
Dim Rst As Recordset
Dim StrPath
Parametros_de_Inicializacao "SysPen.par"
Dim NomeBD As String

NomeBD = "Syspen_be.accdb"
StrPath = DirBancoDados & NomeBD



Set Rst = dbs.OpenRecordset("select * from Fotos_Detentos " & _
"IN '" & StrPath & "'" & _
"where IDFoto=" & Me!ID)
If EstaVazio(Me!ID) = False Then
If MsgBox("Tem certeza de que deseja excluir a(s) foto(s) do detento " & Me!NomeDetento & " ?", vbQuestion Or vbYesNo Or vbDefaultButton2, "Exclusão de Foto de Detento") = vbYes Then
Select Case mFoto
Case 0
DelArq VerifApostrofe(Rst!CaminhoFotoRosto)
dbs.Execute "update Fotos_Detentos " & _
"set caminhofotorosto=null " & _
"IN '" & StrPath & "'" & _
"where IDFoto=" & Me!ID
Case 1
DelArq VerifApostrofe(Rst!CaminhoPerfil1)
dbs.Execute "update Fotos_Detentos " & _
"set caminhoperfil1=null " & _
"IN '" & StrPath & "'" & _
"where IDFoto=" & Me!ID
Case 2
DelArq VerifApostrofe(Rst!CaminhoPerfil2)
dbs.Execute "update Fotos_Detentos " & _
"set caminhoperfil2=null " & _
"IN '" & StrPath & "'" & _
"where IDFoto=" & Me!ID
Case 3
DelArq VerifApostrofe(Rst!CaminhoPerfil3)
dbs.Execute "update Fotos_Detentos " & _
"set caminhoperfil3=null " & _
"IN '" & StrPath & "'" & _
"where IDFoto=" & Me!ID
Case 4
DelArq VerifApostrofe(Rst!CaminhoPerfil4)
dbs.Execute "update Fotos_Detentos " & _
"set caminhoperfil4=null " & _
"IN '" & StrPath & "'" & _
"where IDFoto=" & Me!ID
Case Else
mDir = DirFotos & Me!ID
If EstaVazio(Rst!CaminhoFotoRosto) = False Then DelArq VerifApostrofe(Rst!CaminhoFotoRosto)
If EstaVazio(Rst!CaminhoPerfil1) = False Then DelArq VerifApostrofe(Rst!CaminhoPerfil1)
If EstaVazio(Rst!CaminhoPerfil2) = False Then DelArq VerifApostrofe(Rst!CaminhoPerfil2)
If EstaVazio(Rst!CaminhoPerfil3) = False Then DelArq VerifApostrofe(Rst!CaminhoPerfil3)
If EstaVazio(Rst!CaminhoPerfil4) = False Then DelArq VerifApostrofe(Rst!CaminhoPerfil4)
dbs.Execute "update Fotos_Detentos " & _
"IN '" & StrPath & "'" & _
"set caminhofotorosto=null," & _
"caminhoperfil1=null," & _
"caminhoperfil2=null," & _
"caminhoperfil3=null," & _
"caminhoperfil4=null " & _
"where IDFoto=" & Me!ID
Del_DirArq mDir, ""
Limpar
End Select
Me!lstDetento.Requery
LiberaSalva
Me!Foto.Picture = FotoPadrao
End If
Else
MsgBox "Não foi selecionado detento cujas fotos deferão ser eliminadas.", vbExclamation Or vbOKOnly, "Seleção de Detento"
End If
End Sub


Enjoy!

Aqui só para exclarecimento, algumas das outras funções contidas no código de exclusão postado acima:

Public Function EstaVazio(Texto) As Boolean
EstaVazio = IIf(Not IsNull(Texto) And Len(Trim(Texto)) <> 0 And Not IsEmpty(Texto), False, True)
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

Public Sub Del_DirArq(Diretorio As String, Arquivos As String)
Dim Arq As String
Arq = Dir(Diretorio & Arquivos)
Do While Arq <> ""
Kill Diretorio & Arq
Arq = Dir()
Loop
If EstaVazio(Arquivos) = True Then
On Error Resume Next
RmDir Diretorio
On Error GoTo 0
End If
End Sub

Public Sub DelArq(mArq)
If EstaVazio(mArq) = False Then
On Error Resume Next
Kill mArq
On Error GoTo 0
End If
End Sub