Este fórum está sendo desativado

[GRS007]

Boa Noite!

Gostaria da ajuda de vocês com um projeto que estou montando.
Não sei o que pode tar causando isso.

Obs: aqui em baixo tem o userform que esta dando erro e o modulo que conecta com o Banco de Dados Access

(UserForm)

Private Conect As Object, Rs As Object

Private Sub BT_CADASTRAR_Click()

'On Error GoTo ERRO


'If pClienteCadastrar = False Then FORM_MSG.CarregarMsg ("Acesso negado, sem permissão!"): Exit Sub '"Você não tem permissão para cadastrar!", vbCritical, "Acesso negado!": Exit Sub

If VerificaExistenciaCPF = True Then Exit Sub


' --------------------- CAMPOS OBRIGATORIO ---------------------

If TXT_CLIENTE = "" Then
MsgBox "NOME é obrigatório!", vbCritical, "Aviso!"
TXT_CLIENTE.SetFocus
Exit Sub
End If

If TXT_CPF = "" Then
MsgBox "CPF é obrigatório!", vbCritical, "Aviso!"
TXT_CPF.SetFocus
Exit Sub
End If

If TXT_STATUS = "" Then
MsgBox "STATUS é obrigatório!", vbCritical, "Aviso!"
TXT_STATUS.SetFocus
Exit Sub
End If

If TXT_LIMITE = "" Then
MsgBox "LIMITE DE CREDIÁRIO é obrigatório!", vbCritical, "Aviso!"
TXT_LIMITE.SetFocus
Exit Sub
End If


Dim Rs As New ADODB.Recordset
Dim SQL As String

Call CONEXÃO

If TXT_CLIENTE.Value = Empty Then TXT_CLIENTE.Value = 0
If TXT_APELIDO.Value = Empty Then TXT_APELIDO.Value = 0

If TXT_CPF.Value = Empty Then TXT_CPF.Value = 0
If TXT_RG.Value = Empty Then TXT_RG.Value = 0

If TXT_TELEFONE.Value = Empty Then TXT_TELEFONE.Value = 0
If TXT_CELULAR.Value = Empty Then TXT_CELULAR.Value = 0

If TXT_CEP.Value = Empty Then TXT_CEP.Value = 0
If TXT_ENDEREÇO.Value = Empty Then TXT_ENDEREÇO.Value = 0
If TXT_N.Value = Empty Then TXT_N.Value = 0
If TXT_BAIRRO.Value = Empty Then TXT_BAIRRO.Value = 0
If TXT_CIDADE.Value = Empty Then TXT_CIDADE.Value = 0

If TXT_STATUS.Value = Empty Then TXT_STATUS.Value = 0
If TXT_LIMITE.Value = Empty Then TXT_LIMITE.Value = 0

If TXT_DATA_CADASTRO.Value = Empty Then TXT_DATA_CADASTRO.Value = 0
If TXT_ULT_ATUALIZAÇÃO.Value = Empty Then TXT_ULT_ATUALIZAÇÃO.Value = 0



If Me.TXT_ID.Value <> "" Then
SQL = "SELECT * FROM BD_CLIENTE WHERE ID = " & Me.TXT_ID.Value
Else
SQL = "SELECT * FROM BD_CLIENTE Where ID = 0"
End If

' !!!!!!! TA DANDO ERRO AQUI !!!!!!!!!! Erro em tempo de execução 3709 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Rs.Open SQL, db, adOpenKeyset, adLockOptimistic

If Rs.RecordCount = 0 Then
Rs.AddNew
End If

Rs.Fields("NOME").Value = Me.TXT_CLIENTE.Value
Rs.Fields("APELIDO").Value = Me.TXT_APELIDO.Value

Rs.Fields("CPF").Value = Me.TXT_CPF.Value
Rs.Fields("RG").Value = Me.TXT_RG.Value

Rs.Fields("TELEFONE").Value = Me.TXT_TELEFONE.Value
Rs.Fields("CELULAR_WHATSAPP").Value = Me.TXT_CELULAR.Value

Rs.Fields("CEP").Value = Me.TXT_CEP.Value
Rs.Fields("ENDEREÇO").Value = TXT_ENDEREÇO.Value
Rs.Fields("N").Value = Me.TXT_N.Value
Rs.Fields("BAIRRO").Value = Me.TXT_BAIRRO.Value
Rs.Fields("CIDADE").Value = Me.TXT_CIDADE.Value

Rs.Fields("STATUS").Value = Me.TXT_STATUS.Value
Rs.Fields("LIMITE").Value = Me.TXT_LIMITE.Value

Rs.Fields("DATA_CADASTRO").Value = Me.TXT_DATA_CADASTRO.Value
Rs.Fields("ULT_ATUALIZAÇÃO").Value = Me.TXT_ULT_ATUALIZAÇÃO.Value


Rs.Update

Me.TXT_ID.Value = ""
Me.TXT_CLIENTE.Value = ""
Me.TXT_APELIDO.Value = ""

Me.TXT_CPF.Value = ""
Me.TXT_RG.Value = ""

Me.TXT_CEP.Value = ""
Me.TXT_ENDEREÇO.Value = ""
Me.TXT_N.Value = ""
Me.TXT_BAIRRO.Value = ""
Me.TXT_CIDADE.Value = ""

Me.TXT_TELEFONE.Value = ""
Me.TXT_CELULAR.Value = ""

Me.TXT_DATA_CADASTRO.Value = ""
Me.TXT_ULT_ATUALIZAÇÃO.Value = ""

Me.TXT_LIMITE.Value = ""
Me.TXT_STATUS.Value = ""

TXT_CLIENTE.SetFocus

' $$$$$$$$$$$$ ARRUMAR $$$$$$$$$$$$

'Carregar_Lista
FORM_BARRA.Show


FORM_MSG.CarregarMsg ("Operação realizada com sucesso!")
Form_MENU.MultiPage1.Value = 1

Exit Sub
ERRO:
MsgBox "Erro!", vbCritical, "ERRO"
End Sub


Private Sub UserForm_Activate()
'On Error GoTo AVISO

' $$$$$$$$$$$$ VER SE VAI USAR $$$$$$$$$$$
'Form_CLIENTE.MultiPage1.Value = 0


TXT_CLIENTE.SetFocus

' $$$$$$$$$$$$ VER SE VAI USAR $$$$$$$$$$$
'Carregar_Lista
'
'Me.Top = 0
'Me.Left = 0
'Me.Height = Application.Height - 8
'Me.Width = Application.Width - 8


TXT_STATUS.AddItem "ATIVO"
TXT_STATUS.AddItem "INATIVO"
TXT_STATUS.AddItem "BLOQUEADO"


'Exit Sub
'AVISO:
'MsgBox "Ocorreu uma inconsistência", vbCritical, "ERRO"
End Sub

----------------------------------------- X --------------------------------------------- X -------------------------------------------------

(Módulo)

Public db As New ADODB.Connection
Public path As String
Public Rs As New ADODB.Recordset

Sub CONEXÃO()
On Error GoTo ERRO

'#If VBA7 And Win64 Then
'db.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & "\Banco_de_Dados.accdb"



'With db
'.Provider = "Microsoft.JET.OLEDB.4.0"
'.ConnectionString = "Data Source=" & ThisWorkbook.path & "\Banco_de_Dados.accdb;" & _
'"Jet OLEDB:Database Password=123"
'.Mode = adModeReadWrite
'.Open
'End With


'CASO O BANCO ESTEJA EM OUTRA PASTA
'"Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source = C:\Users\User 01\Documents\Banco_de_Dados.accdb"

'#Else
'db.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\Banco_de_Dados.accdb"


With db
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.path & "\Banco_de_Dados.accdb;'" & _
"Jet OLEDB:Database Password=123"

'.ConnectionString = "Data Source=C:\dbpdv\Banco_de_Dados.accdb;Jet OLEDB:Database Password=123"

.Mode = adModeReadWrite
.Open

End With


'CASO O BANCO ESTEJA EM OUTRA PASTA
'"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\Banco_de_Dados.accdb"
'#End If

'Debug.Print "Conectado"

Exit Sub
ERRO:
'Debug.Print Err.Description
End Sub