Boa noite.
Tenho um sistema em access e estou apanhando numa coisa simples (Acredito eu).
Estou montando um bloqueio de expiração no sistema.
Tenho o Seguinte codigo no botão Logar..
Option Compare Database
Private Sub btn_logar_Click()
On Error GoTo deu_erro
'Ao Invés desta data escrita, eu quero que puxe a data na tabela "Vencimento", no campo "Data_Validade".
If DateValue("13/7/2017") >= Now() Then
DoCmd.OpenForm "BARRA DE PROGRESSO"
Else
MsgBox "A data de validade expirou!"
DoCmd.Close
End If
Set wshell = CreateObject("Wscript.Shell")
wshell.PopUp "Acessando dados no Servidor...Aguarde...", 4, "Conectando com Servidor", 5
Dim Status As Long
Dim max As Long
max = 10000
SysCmd acSysCmdInitMeter, "Consultando Banco de Dados...", max
For Status = 0 To max
SysCmd acSysCmdUpdateMeter, Status
If Status Mod 1 = 0 Then
DoEvents
End If
Next Status
Dim NOMEUSU As String
Dim SENUSU As String
NOMEUSU = UCase(Nz(Me.txt_usuario.Value, ""))
SENUSU = UCase(Nz(Me.txt_senha.Value, ""))
If IsEmpty(NOMEUSU) Or IsEmpty(SENUSU) Then
MsgBox "Preencha os Campos..", vbOKOnly + vbCritical, "Impossível Acessar!!"
Else
If ExisteUsuario(NOMEUSU, SENUSU) Then
DoCmd.Close
DoCmd.OpenForm "INICIO"
MsgBox "Bem Vindo Ao SisLojasMM", vbOKOnly, "Bem Vindo"
Else
NumInteiro = NumInteiro + 1
If NumInteiro <= 2 Then
MsgBox "Usuário e Senhas Incorretos..", vbOKOnly + vbCritical, "Tente Novamente!!"
Me.txt_usuario.Value = ""
Me.txt_senha.Value = ""
Me.txt_usuario.SetFocus
Else
MsgBox "Você excedeu o numero de tentativas..", vbOKOnly + vbCritical, "Sair do Sistema!!"
DoCmd.Quit
End If
End If
End If
Exit Sub
deu_erro:
MsgBox Err.Description
End Sub
Public Function ExisteUsuario(strNomeUsuario As String, strSenhaUsuario As String) As Boolean
On Error GoTo deu_erro
Dim rst As DAO.Recordset
Dim sql As String
sql = "SELECT * FROM [USUARIOS] US WHERE US.[NOME_USUARIO] = '" & strNomeUsuario & "' AND US.[SENHA_USUARIO] = '" & strSenhaUsuario & "'"
Set rst = CurrentDb.OpenRecordset(sql)
If rst.BOF And rst.EOF Then
ExisteUsuario = False
Else
ExisteUsuario = True
NOME_USUARIO = rst!NOME_USUARIO
USUARIO_SENHA = rst!SENHA_USUARIO
NOME = rst!NOME_
SOBRENOME = rst!SOBRENOME
'Vendas = rst!Vendas
'CANCELAR_VENDA = rst!CANCELAR_VENDA
'CONSULTAS = rst!CONSULTAS
'CATALOGOS = rst!CATALOGOS
'RELATORIOS = rst!RELATORIOS
'ADMINISTRAR = rst!ADMINISTRAR
End If
rst.Clone
Set rst = Nothing
Exit Function
deu_erro:
MsgBox Err.Description
End Function
Alguem pode ajudar?
Tenho um sistema em access e estou apanhando numa coisa simples (Acredito eu).
Estou montando um bloqueio de expiração no sistema.
Tenho o Seguinte codigo no botão Logar..
Option Compare Database
Private Sub btn_logar_Click()
On Error GoTo deu_erro
'Ao Invés desta data escrita, eu quero que puxe a data na tabela "Vencimento", no campo "Data_Validade".
If DateValue("13/7/2017") >= Now() Then
DoCmd.OpenForm "BARRA DE PROGRESSO"
Else
MsgBox "A data de validade expirou!"
DoCmd.Close
End If
Set wshell = CreateObject("Wscript.Shell")
wshell.PopUp "Acessando dados no Servidor...Aguarde...", 4, "Conectando com Servidor", 5
Dim Status As Long
Dim max As Long
max = 10000
SysCmd acSysCmdInitMeter, "Consultando Banco de Dados...", max
For Status = 0 To max
SysCmd acSysCmdUpdateMeter, Status
If Status Mod 1 = 0 Then
DoEvents
End If
Next Status
Dim NOMEUSU As String
Dim SENUSU As String
NOMEUSU = UCase(Nz(Me.txt_usuario.Value, ""))
SENUSU = UCase(Nz(Me.txt_senha.Value, ""))
If IsEmpty(NOMEUSU) Or IsEmpty(SENUSU) Then
MsgBox "Preencha os Campos..", vbOKOnly + vbCritical, "Impossível Acessar!!"
Else
If ExisteUsuario(NOMEUSU, SENUSU) Then
DoCmd.Close
DoCmd.OpenForm "INICIO"
MsgBox "Bem Vindo Ao SisLojasMM", vbOKOnly, "Bem Vindo"
Else
NumInteiro = NumInteiro + 1
If NumInteiro <= 2 Then
MsgBox "Usuário e Senhas Incorretos..", vbOKOnly + vbCritical, "Tente Novamente!!"
Me.txt_usuario.Value = ""
Me.txt_senha.Value = ""
Me.txt_usuario.SetFocus
Else
MsgBox "Você excedeu o numero de tentativas..", vbOKOnly + vbCritical, "Sair do Sistema!!"
DoCmd.Quit
End If
End If
End If
Exit Sub
deu_erro:
MsgBox Err.Description
End Sub
Public Function ExisteUsuario(strNomeUsuario As String, strSenhaUsuario As String) As Boolean
On Error GoTo deu_erro
Dim rst As DAO.Recordset
Dim sql As String
sql = "SELECT * FROM [USUARIOS] US WHERE US.[NOME_USUARIO] = '" & strNomeUsuario & "' AND US.[SENHA_USUARIO] = '" & strSenhaUsuario & "'"
Set rst = CurrentDb.OpenRecordset(sql)
If rst.BOF And rst.EOF Then
ExisteUsuario = False
Else
ExisteUsuario = True
NOME_USUARIO = rst!NOME_USUARIO
USUARIO_SENHA = rst!SENHA_USUARIO
NOME = rst!NOME_
SOBRENOME = rst!SOBRENOME
'Vendas = rst!Vendas
'CANCELAR_VENDA = rst!CANCELAR_VENDA
'CONSULTAS = rst!CONSULTAS
'CATALOGOS = rst!CATALOGOS
'RELATORIOS = rst!RELATORIOS
'ADMINISTRAR = rst!ADMINISTRAR
End If
rst.Clone
Set rst = Nothing
Exit Function
deu_erro:
MsgBox Err.Description
End Function
Alguem pode ajudar?