MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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

5 participantes

    [Resolvido]InputBox para senha *****

    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty [Resolvido]InputBox para senha *****

    Mensagem  flecha 11/1/2023, 18:15

    Olá, Baixei um exemplo de uma instrução para uma InputBox quaé chamada por um Comando e abre com
    **** Asteristicos  para entrar a senha para deletar um registro.

    Eu não sei se na mudança de versão da Access passou a dar esse erro quando vai executar a chamada.
    Antes estava no Access 2010 e agora estou com o 2019.

    Erro de Compilação
    Tipos incompatíveis     na linha abaixo: AddressOf NewProc

    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) ---->AddressOf NewProc

    Código:

     '// Make it public = avail to ALL Modules
    '// Lets simulate the VBA Input Function
    Public Function InputBoxDK(Prompt As String, Optional Title As String, _
    Optional Default As String, _
    Optional Xpos As Long, _
    Optional Ypos As Long, _
    Optional Helpfile As String, _
    Optional Context As Long) As String



    Dim lngModHwnd As Long, lngThreadID As Long

    '// Lets handle any Errors JIC! due to HookProc> App hang!
    On Error GoTo ExitProperly
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)

    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) ---->AddressOf NewProc

    If Xpos Then
    InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
    Else
    InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
    End If

    ExitProperly:
    UnhookWindowsHookEx hHook

    End Function
    gilberlanio
    gilberlanio
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 779
    Registrado : 30/08/2010

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  gilberlanio 11/1/2023, 18:20

    Tente usar esse modelo. Salve um código em módulo.
    Use ele a bastante tempo e nunca deu problema

    Código:
    Option Compare Database
    Option Explicit
    '////////////////////////////////////////////////////////////////////
    'Password masked inputbox
    'Allows you to hide characters entered in a VBA Inputbox.
    '
    'Code written by Daniel Klann
    'March 2003
    '////////////////////////////////////////////////////////////////////

    #If VBA7 Then
        #If Win64 Then
            Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongLong, _
                                                    ByVal ncode As LongLong, ByVal wParam As LongLong, lParam As Any) As LongLong
                                                   
            Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias _
                                                    "GetModuleHandleA" (ByVal lpModuleName As String) As LongLong
           
            Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                                (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, _
                                                ByVal dwThreadId As Long) As LongPtr
           
            Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
           
            Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
                                                (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
                                                ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
           
            Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                                  (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
           
            Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
        #Else
            Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                                  ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
           
            Private Declare Function GetModuleHandle Lib "kernel32" Alias _
                                                    "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
           
            Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                                      (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
                                                      ByVal dwThreadId As Long) As Long
           
            Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
           
            Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
                                                        (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
                                                        ByVal wParam As Long, ByVal lParam As Long) As Long
           
            Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                                  (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
           
            Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
        #End If
    #Else
    'API functions to be used
        Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                              ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
       
        Private Declare Function GetModuleHandle Lib "kernel32" Alias _
                                                "GetModuleHandleA" (ByVal lpModuleName As String) As Long
       
        Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                                  (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
                                                  ByVal dwThreadId As Long) As Long
       
        Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
       
        Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
                                                    (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
                                                    ByVal wParam As Long, ByVal lParam As Long) As Long
       
        Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                              (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
       
        Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    #End If


    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0

    #If VBA7 Then
        #If Win64 Then
            Private hHook As LongLong
        #Else
            Private hHook As LongPtr
        #End If
    #Else
        Private hHook As Long
    #End If


    #If VBA7 Then
        #If Win64 Then
            Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongLong
                Dim RetVal
                Dim strClassName As String, lngBuffer As Long
           
                If lngCode < HC_ACTION Then
                    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
                    Exit Function
                End If
           
                strClassName = String$(256, " ")
                lngBuffer = 255
           
                If lngCode = HCBT_ACTIVATE Then
           
                    RetVal = GetClassName(wParam, strClassName, lngBuffer)
           
                    If Left$(strClassName, RetVal) = "#32770" Then
           
                        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
                    End If
                End If
           
                CallNextHookEx hHook, lngCode, wParam, lParam
            End Function
        #Else
            Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
                Dim RetVal
                Dim strClassName As String, lngBuffer As Long
           
                If lngCode < HC_ACTION Then
                    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
                    Exit Function
                End If
           
                strClassName = String$(256, " ")
                lngBuffer = 255
           
                If lngCode = HCBT_ACTIVATE Then
           
                    RetVal = GetClassName(wParam, strClassName, lngBuffer)
           
                    If Left$(strClassName, RetVal) = "#32770" Then
           
                        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
                    End If
                End If
           
                CallNextHookEx hHook, lngCode, wParam, lParam
            End Function
        #End If
    #Else
        Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
            Dim RetVal
            Dim strClassName As String, lngBuffer As Long
       
            If lngCode < HC_ACTION Then
                NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
                Exit Function
            End If
       
            strClassName = String$(256, " ")
            lngBuffer = 255
       
            If lngCode = HCBT_ACTIVATE Then
       
                RetVal = GetClassName(wParam, strClassName, lngBuffer)
       
                If Left$(strClassName, RetVal) = "#32770" Then
       
                    SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
                End If
            End If
       
            CallNextHookEx hHook, lngCode, wParam, lParam
       
        End Function
    #End If


    #If VBA7 Then
        #If Win64 Then
            Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
                                    Optional YPos, Optional HelpFile, Optional Context) As String
                Dim lngModHwnd As LongLong, lngThreadID As Long
           
                lngThreadID = GetCurrentThreadId
                lngModHwnd = GetModuleHandle(vbNullString)
           
                hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
           
                InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
                UnhookWindowsHookEx hHook
           
            End Function
        #Else
            Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
                                    Optional YPos, Optional HelpFile, Optional Context) As String
                Dim lngModHwnd As Long, lngThreadID As Long
           
                lngThreadID = GetCurrentThreadId
                lngModHwnd = GetModuleHandle(vbNullString)
           
                hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
           
                InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
                UnhookWindowsHookEx hHook
           
            End Function
        #End If
    #Else
    'API functions to be used
        Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
                                Optional YPos, Optional HelpFile, Optional Context) As String
            Dim lngModHwnd As Long, lngThreadID As Long
       
            lngThreadID = GetCurrentThreadId
            lngModHwnd = GetModuleHandle(vbNullString)
       
            hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
       
            InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
            UnhookWindowsHookEx hHook
       
        End Function
    #End If


    .................................................................................
    Sistemas completos com fonte aberto (Apresentação)

    Vários Exemplos Grátis
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2772
    Registrado : 13/12/2016

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Alexandre Fim 11/1/2023, 18:57

    Norimar boa tarde,

    Minha sugestão é criar um formulário para esta função, que seja "PopUp" e "Janela Restrita", em conjunto com uma variável global do tipo Boolean.
    Exemplo:

    Código:

    Private Sub cmdExcluir_Click()

        '-- ROTINA PARA ABRIR FORMULÁRIO DE SENHA ---------------------------------------------
        DoCmd.OpenForm "NOME_FORMULARIO_SENHA", acNormal
        
        '-- No Form_Load() do formulário de senha informar:
        '-- Por padrão, manter a variável global como FALSE (vgOK = FALSE)
        '-- vgOk = False
      

        '-- SE O USUÁRIO INFORMOU A SENHA CORRETA, muda a variável global para TRUE
        
        '--------------------------------------------------------------------------------------
      
        
        
        If vgOK = True Then
            '-- Instrução para exclusão do registro
            CurrentDb.Execute ("DELETE FROM NOME_TABELA WHERE ID = ID_DO_REGISTRO")
            MsgBox "Regsitro excluido com sucesso.", vbInformation, "Mensagem"
            
            '-- Retorna valor para FALSE
            vgOK = False
            
        End If

    End Sub



    Declaração da variavel global em algum módulo qualquer do teu sistema

    Global vgOK As Boolean


    Desta forma não é necessário o uso de API e também evita qualquer incompatibilidade entre versões 32 e 64.

    Tente isso !!

    Att,

    Alexandre Fim


    .................................................................................
    Arrow  Marcar tópico como Resolvido: clique aqui
    Arrow  Postar anexos no fórum: clique aqui

    [Resolvido]InputBox para senha ***** Setinf11
    Sistemas e Tecnologia Ltda
    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 11/1/2023, 19:58

    Olá,
    como sugeriu o Alexandre,
    eu também sugiro um formulário popup.

    No meu canal do Youtube ensino a criar uma InputBox personalizada com senha, utilizando apenas formulário
    e VBA, sem uso de APIs, que se comporta igual a já existente no Access.

    Segue:



    Bons estudos!


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11

    flecha gosta desta mensagem

    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2772
    Registrado : 13/12/2016

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Alexandre Fim 11/1/2023, 20:11

    Grande @Marcelo David !!
    Agora ficou "mastigado" para o @flecha...rss


    .................................................................................
    Arrow  Marcar tópico como Resolvido: clique aqui
    Arrow  Postar anexos no fórum: clique aqui

    [Resolvido]InputBox para senha ***** Setinf11
    Sistemas e Tecnologia Ltda

    Marcelo David gosta desta mensagem

    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 16/1/2023, 13:45

    Bom dia senhores!
    flecha conseguiu chegar a algum resultado?


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11
    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  flecha 17/1/2023, 18:25

    Obrigado a todos,
    com essa coletânia de exemplos fornecida pelos colega
    consegui resolver.


    Vou estudar a do Marcelo que gostei muito.

    Obrigado a todos!


    Última edição por flecha em 17/1/2023, 19:43, editado 1 vez(es)

    Marcelo David gosta desta mensagem

    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 17/1/2023, 19:01

    Opa! Ótimo que deu certo!
    Gratos pelo retorno!


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11
    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  flecha 18/1/2023, 12:40

    Marcelo,
    ficou assim no meu BTExcluir

    Private Sub cmdExcluir_Click()
    If InputBoxPWD("Excluir registro atual? Precisa SENHA !!", "Senha Nescessária!") = "1234" Then
    DoCmd.RunCommand acCmdDeleteRecord

    MsgBox "Registro apagado", vbInformation, "Excluído"
    Else
    MsgBox "Senha não Confere!!!"
    Cancel = True
    End If

    End Sub

    Quando eu clico em Excluir e executa a rotina, pergunta se quer excluir mesmo, SIM ou NÃO, certo ?
    Quando NÃO abre o código erro em tempo de execução 2501, posso colocar um tratamento de erro para não informar
    e cancelar e abortar mesmo ?
    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 18/1/2023, 14:20

    Olá!
    Poderá tratar a senha errada e o "Não" do botão.

    Possivelmente um Error Resume Next já resolva.

    *Reabri o tópico. Quando resolver definitivamente, marque novamente como resolvido.

    E se o assinto se desviar muito, crie um novo tópico e copiar as mensagens dessa nova
    questão para o novo tópico, daí apagarei desse essas dúvidas.



    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11
    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  flecha 23/1/2023, 18:25

    Oi Marcelo, não estou conseguindo tratar o Não do Botão, pois ele sempre volta para as instruçoes
    do InputBox.
    Não interrompe a sequência.

    Continua a executar os comandos do botão Excluir.

    Private Sub cmdExcluir_Click()


    On Error GoTo erro

    If InputBoxPWD("Excluir registro atual? Precisa SENHA !!", "Senha Nescessária!") = "1234" Then
    DoCmd.RunCommand acCmdDeleteRecord

    MsgBox "Registro apagado", vbInformation, "Excluído"

    Exit Sub

    Else


    MsgBox "Senha não Confere!!!"
    Cancel = True

    erro:
    If Error = 2501 Then Cancel = True
    End If

    End Sub


    Botão CANCELAR do From FrmInputBox

    Private Sub btnCanc_Click()
    MsgBox "Deseja Cancelar??", vbCritical, "Cancelada Operação"

    DoCmd.Close acForm, "frminputbox", acSaveYes
    Exit Sub



    End Sub
    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 24/1/2023, 03:06

    Boa noite.

    flecha escreveu:Botão CANCELAR do From FrmInputBox

    Private Sub btnCanc_Click()
    MsgBox "Deseja Cancelar??", vbCritical, "Cancelada Operação"

    DoCmd.Close acForm, "frminputbox", acSaveYes
    Exit Sub



    End Sub

    Não entendi esse código. O ImpuboxPWD, não deve ser alterada. Deve-se usar semelhente ao usa da original do Access.

    *O Cancel = True é desnecessário no else.


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11
    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  flecha 24/1/2023, 10:48

    Botão Excluir chama a InputBoxPWD abrindo o Form

    Ai clico em Cancelar , ele cancela mas também passa pela mensagem de Senha não Confere!
    Achei que deveria fechra o form InputBoxPWD e voltar para o Form que a chamou onde estão os registros!

    Private Sub btnCanc_Click()

    MsgBox "Deseja Cancelar??", vbCritical, "Cancelada Operação"

    DoCmd.Close acForm, "frminputbox", acSaveYes

    Exit Sub

    End Sub

    Dessa forma abre a pergunta se confirma o CANCELA, abre a mensagem pedindo a confirmação, clico em sim ai ele vem a mensagem de Senha não confere!
    Ele prossegue como se tivesse preeenchido senha errada e clicado OK, mesmo estando o txtinput vazio.

    Se eu clicar OK sem preencher senha sempre passa mela mensagem Senha não confere.

    Botão EXCLUIR

    Private Sub cmdExcluir_Click()
    On Error GoTo erro

    If InputBoxPWD("Excluir registro atual? Precisa SENHA !!", "Senha Nescessária!") = "1234" Then
       DoCmd.RunCommand acCmdDeleteRecord

       MsgBox "Registro apagado", vbInformation, "Excluído"

       Exit Sub

         Else
           MsgBox "Senha não Confere!!!"
               
       End If
       
    erro:
    If Error = 2501 Then Cancel = True


    End Sub

    Quando clico em EXCLUIR e cancelo no form frmInput abre a confirmação e mesmo assim mostra mensagem de Senha não confere.


    Não estou entendendo!
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5028
    Registrado : 20/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Silvio 24/1/2023, 11:16

    Senhores, bom dia.

    Apenas um pitaco. Segue abaixo a forma como é feita a exclusão em alguns sistemas que eu faço.

    A rotina abaixo é feita com a senha de exclusão é a mesma de acesso ao sistema.


    Private Sub bt_excluir_Click()
    On Error GoTo fim

    'módulo mdlinpubox para a senha de exclusão
    On Error GoTo fim
    Dim strSenhaUser As String, strSenhaAtual 'Senha do usuário gravada no bd
    Dim strUsuario As Integer 'Senha digitada pelo usuário


    strSenhaAtual = InputBoxDK("Digite a senha para a exclusão", "Senha", "******") 'Informa a senha a ser comparada
    strSenhaUser = DLookup("[SENHA]", "USUARIOS", "[USER] = '" & Forms!login!USER & "'") 'Busco a senha real do usuário

    If strSenhaAtual <> strSenhaUser Then 'Caso a senha digitada for diferente da senha do usuário, interrompo o código
    MsgBox "Senha incorreta, tente novamente", vbInformation, Me.Caption
    Exit Sub
    End If



    Dim numRecord As Integer
    numRecord = InputBox("Informe o Nº do Cliente..:", Me.Caption)

    If MsgBox("Deseja excluir o Cliente:" & vbCrLf & Me.Cliente & " ?", vbQuestion + vbYesNo, Me.Caption) = vbYes Then

    Dim SQL As String
    DoCmd.SetWarnings False
    SQL = "DELETE * FROM tblcliente WHERE idcliente = " & numRecord

    DoCmd.RunSQL SQL

    MsgBox "Exclusão realizada com sucesso!", vbInformation, Me.Caption
    DoCmd.GoToRecord , , acNewRec

    Else
    MsgBox " Ação cancelada pelo usuário", vbInformation, Me.Caption



    End If
    DoCmd.RunCommand acCmdRefresh

    fim:
    If Err.Number = 13 Then
    MsgBox "Cliente não excluido !" & vbCrLf & " Ação cancelada pelo usuário.", vbInformation, Me.Caption
    End If


    End Sub


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  flecha 24/1/2023, 14:49

    Estou colocando o Arquivo de teste
    com 3 Botões de Deletar.
    Anexos
    [Resolvido]InputBox para senha ***** AttachmentTeste Exclui com senha.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (260 Kb) Baixado 13 vez(es)


    Última edição por flecha em 24/1/2023, 14:52, editado 1 vez(es) (Motivo da edição : Incluir Arquivo)
    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 24/1/2023, 15:39

    Boa tarde pessoal!

    Flecha, refiz a InputBoxPWD exatamente como ensinei na videoaula e usei ela no código do botão excluir vermelho.

    Código comentado.

    *Os campos Cargo, Exercicio e Local  no seu formulário não tem na tabela11. Como eles provavelmente são chave estrangeira, precisa criar
    os campos correspondentes.

    Baixe aqui e teste por gentileza.


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11

    flecha gosta desta mensagem

    avatar
    flecha
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 296
    Registrado : 11/01/2012

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  flecha 24/1/2023, 19:01

    Obrigado a todos pelo empenho.

    Agora vou fixar no meu BD.

    Como diz um ai do forum:
    Só sei que Nada Sei!
    cheers cheers cheers

    Marcelo David gosta desta mensagem

    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3665
    Registrado : 21/04/2011

    [Resolvido]InputBox para senha ***** Empty Re: [Resolvido]InputBox para senha *****

    Mensagem  Marcelo David 25/1/2023, 02:12

    Opa, maravilha. Grato pelo retorno!


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    [Resolvido]InputBox para senha ***** Marcel11

    flecha gosta desta mensagem


      Data/hora atual: 8/2/2023, 01:30