MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    HARYSOHN
    HARYSOHN
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12227
    Registrado : 01/03/2011

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

    Mensagem  HARYSOHN em 27/6/2011, 14:33

    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!
    HARYSOHN
    HARYSOHN
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12227
    Registrado : 01/03/2011

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

    Mensagem  HARYSOHN em 27/6/2011, 14:40

    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

      Data/hora atual: 29/11/2020, 16:37