Conexão Banco de Dados Access Arquivo accdb  [Resolvido]

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Conexão Banco de Dados Access Arquivo accdb

Mensagempor ACG » Qua Set 11, 2019 7:48 pm

Boa noite a todos.
Estou criando um projeto que necessita uma conexão com banco de dados Access. Alguém poderia me ajudar? Pois estou usando os códigos abaixo que efetua conexão com arquivo mdb. Este tipo de arquivo não permite programar campo calculado nas tabelas além de outras limitações, já o arquivo accdb garante estes recursos.
Os códigos com conexão mdb que utilizo estão em anexo .
Código: Selecionar todos
[b][u]MODULO[/u][/b]
Public Total As Long                                                                                     
Sub AbreForm()
    frmCadastro.Show
End Sub
Public Function Id()
    Dim cx As New ClasseConexao
    Dim banco As ADODB.Recordset
    Dim sql As String
    Dim i As Long
     sql = "SELECT * FROM Fornecedores"
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    Total = banco.RecordCount
    For i = 1 To banco.RecordCount
        If banco(0) = frmPesquisa.lstv.SelectedItem Then
            Id = i
            Exit For
        Else
            banco.MoveNext
        End If
   Next
      Set banco = Nothing
   cx.Desconectar
End Function
[b][u]MODULO CLASSE[/u][/b]
Public Conn As New ADODB.Connection
Public Sub Conectar()
    Dim nConectar As String
    nConectar = "Provider=Microsoft.Jet.oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Base.mdb"
    Conn.ConnectionString = nConectar
    Conn.Open
End Sub

[b][u]PROGRAMAÇÃO NO FORM  VBA[/u][/b]
Option Explicit
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643
Public Indice As Long
Public cx As New ClasseConexao
Public banco As ADODB.Recordset
Public sql As String
Sub Incluir_Registro()
    sql = "INSERT INTO Fornecedores(Empresa, Contato, Cargo, Endereço, Cidade, Regiao, Cep, País, Telefone, Fax, HomePage)"
    sql = sql & " VALUES ("
    sql = sql & " '" & Me.txtNomeEmpresa.Value & "'"
    sql = sql & ", '" & Me.txtNomeContato.Value & "'"
    sql = sql & ", '" & Me.txtCargoContato.Value & "'"
    sql = sql & ", '" & Me.txtEndereco.Value & "'"
    sql = sql & ", '" & Me.txtCidade.Value & "'"
    sql = sql & ", '" & Me.txtRegiao.Value & "'"
    sql = sql & ", '" & Me.txtCEP.Value & "'"
    sql = sql & ", '" & Me.txtPais.Value & "'"
    sql = sql & ", '" & Me.txtTelefone.Value & "'"
    sql = sql & ", '" & Me.txtFax.Value & "'"
    sql = sql & ", '" & Me.txtHomePage.Value & "'"
    sql = sql & " )"
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn
    MsgBox "Cadastro efetuado com sucesso.", vbInformation, "Cadastro de Fornecedores"
    Set banco = Nothing
    cx.Desconectar
End Sub
Sub Alterar_Registro()
    'O registro a ser alterado nao pode conter aspas simples

    sql = "UPDATE fornecedores"
    sql = sql & " SET empresa = '" & Me.txtNomeEmpresa & "'"
    sql = sql & ", contato = '" & Me.txtNomeContato & "'"
    sql = sql & ", cargo = '" & Me.txtCargoContato & "'"
    sql = sql & ", endereço = '" & Me.txtEndereco & "'"
    sql = sql & ", cidade = '" & Me.txtCidade & "'"
    sql = sql & ", regiao = '" & Me.txtRegiao & "'"
    sql = sql & ", cep = '" & Me.txtCEP & "'"
    sql = sql & ", país = '" & Me.txtPais & "'"
    sql = sql & ", telefone = '" & Me.txtTelefone & "'"
    sql = sql & ", fax = '" & Me.txtFax & "'"
    sql = sql & ", homepage = '" & Me.txtHomePage & "'"
    sql = sql & " WHERE codigo = " & Me.txtCodigoFornecedor.Value
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn
    MsgBox "Alterado com sucesso.", vbInformation, "Cadastro de Fornecedores"
    Set banco = Nothing
    cx.Desconectar
End Sub
Private Sub btnCancelar_Click()
    btnOK.Enabled = False
    btnCancelar.Enabled = False
    UserForm_Initialize
    Call DesabilitaControles
    Call HabilitaBotoesAlteracao
    Call HabilitaBotoesNavegaçao
    lblMensagem.Caption = Empty
    End Sub
Private Sub btnOK_Click()
    'Altera
    If optAlterar.Value Then
        Call Alterar_Registro
        lblMensagem.Caption = "Registro salvo com sucesso."
    End If
    'Novo
    If optNovo.Value Then
        Call Incluir_Registro
        btnUltimo_Click
        lblMensagem.Caption = "Registro salvo com sucesso."
    End If
    'Excluir
    If optExcluir.Value Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Deseja excluir o fornecedor: " & Me.txtNomeEmpresa & " ?", vbYesNo, "Confirmação")
        If result = vbYes Then
            sql = "DELETE FROM fornecedores"
            sql = sql & " WHERE codigo =  " & Me.txtCodigoFornecedor.Value
            Set banco = New ADODB.Recordset
            cx.Conectar
            banco.Open sql, cx.Conn
            Set banco = Nothing
            cx.Desconectar
            UserForm_Initialize
            lblMensagem.Caption = "Registro excluído com sucesso."
        Else
            btnCancelar_Click
        End If
    End If
    Call HabilitaBotoesAlteracao
    Call DesabilitaControles
    Call HabilitaBotoesNavegaçao
End Sub
Private Sub optAlterar_Click()
    If txtCodigoFornecedor.Text <> vbNullString And txtCodigoFornecedor.Text <> "" Then
        Call HabilitaControles
        Call DesabilitaBotoesAlteracao
        Call DesabilitaBotoesNavegaçao
        'dá o foco ao primeiro controle de dados
        txtNomeEmpresa.SetFocus
    Else
        lblMensagem.Caption = "Não há registro a ser alterado"
    End If
End Sub
Private Sub optExcluir_Click()
    If txtCodigoFornecedor.Text <> vbNullString And txtCodigoFornecedor.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo."
    Else
        lblMensagem.Caption = "Não há registro a ser excluído."
    End If
End Sub
Private Sub optNovo_Click()
    Call LimpaControles
    Call DesabilitaBotoesAlteracao
    Call DesabilitaBotoesNavegaçao
    Call HabilitaControles
    Me.txtNomeEmpresa.SetFocus
End Sub
Sub CarregaRegistros()
     With banco
      If Not IsNull(.Fields(0)) Then
        Me.txtCodigoFornecedor.Value = .Fields(0)
        Me.txtNomeEmpresa.Value = .Fields(1)
        Me.txtNomeContato.Value = .Fields(2)
        Me.txtCargoContato.Value = .Fields(3)
        Me.txtEndereco.Value = .Fields(4)
        Me.txtCidade.Value = .Fields(5)
        Me.txtRegiao.Value = .Fields(6)
        Me.txtCEP.Value = .Fields(7)
        Me.txtPais.Value = .Fields(8)
        Me.txtTelefone.Value = .Fields(9)
        Me.txtFax.Value = .Fields(10)
        Me.txtHomePage.Value = .Fields(11)
      End If
    End With
    lblIndice.Caption = Indice
    lblTotal.Caption = banco.RecordCount
End Sub
Private Sub btnAnterior_Click()
   On Error GoTo final
    sql = "SELECT codigo, empresa, contato, cargo, Endereço, Cidade, regiao, CEP, País, Telefone, Fax, HomePage FROM Fornecedores "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    banco.AbsolutePosition = Indice - 1
    Indice = banco.AbsolutePosition
    Call CarregaRegistros
final:
    Set banco = Nothing
    cx.Desconectar
End Sub
Private Sub btnPesquisar_Click()
    frmPesquisa.Show
End Sub
Private Sub btnPrimeiro_Click()
   On Error GoTo final
    sql = "SELECT codigo, empresa, contato, cargo, Endereço, Cidade, regiao, CEP, País, Telefone, Fax, HomePage FROM Fornecedores "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    banco.AbsolutePosition = 1
    Indice = banco.AbsolutePosition
     Call CarregaRegistros
final:
    Set banco = Nothing
    cx.Desconectar
End Sub
Private Sub btnProximo_Click()
  On Error Resume Next
    sql = "SELECT codigo, empresa, contato, cargo, Endereço, Cidade, regiao, CEP, País, Telefone, Fax, HomePage FROM Fornecedores "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
   If lblIndice.Caption <> lblTotal.Caption Then
    banco.AbsolutePosition = Indice + 1
    Indice = banco.AbsolutePosition
    Call CarregaRegistros
   End If
    Set banco = Nothing
    cx.Desconectar
    Exit Sub
End Sub
Private Sub btnUltimo_Click()
   On Error GoTo final
    sql = "SELECT codigo, empresa, contato, cargo, Endereço, Cidade, regiao, CEP, País, Telefone, Fax, HomePage FROM Fornecedores "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    banco.AbsolutePosition = banco.RecordCount
    Indice = banco.AbsolutePosition
     Call CarregaRegistros
final:
    Set banco = Nothing
    cx.Desconectar
End Sub
Private Sub UserForm_Initialize()
    sql = "SELECT codigo, empresa, contato, cargo, Endereço, Cidade, regiao, CEP, País, Telefone, Fax, HomePage FROM Fornecedores "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
   
    Indice = banco.AbsolutePosition
    Call CarregaRegistros
    Call DesabilitaControles
    Call HabilitaBotoesAlteracao
    Set banco = Nothing
    cx.Desconectar
End Sub
Private Sub LimpaControles()
    Me.txtCodigoFornecedor.Text = ""
    Me.txtNomeEmpresa.Text = ""
    Me.txtNomeContato.Text = ""
    Me.txtCargoContato.Text = ""
    Me.txtEndereco.Text = ""
    Me.txtCidade.Text = ""
    Me.txtRegiao.Text = ""
    Me.txtCEP.Text = ""
    Me.txtPais.Text = ""
    Me.txtTelefone.Text = ""
    Me.txtFax.Text = ""
    Me.txtHomePage.Text = ""
End Sub
Private Sub HabilitaControles()
   'Me.txtCodigoFornecedor.Locked = False
    Me.txtNomeEmpresa.Locked = False
    Me.txtNomeContato.Locked = False
    Me.txtCargoContato.Locked = False
    Me.txtEndereco.Locked = False
    Me.txtCidade.Locked = False
    Me.txtRegiao.Locked = False
    Me.txtCEP.Locked = False
    Me.txtPais.Locked = False
    Me.txtTelefone.Locked = False
    Me.txtFax.Locked = False
    Me.txtHomePage.Locked = False

    Me.txtNomeEmpresa.BackColor = corEnabledTextBox
    Me.txtNomeContato.BackColor = corEnabledTextBox
    Me.txtCargoContato.BackColor = corEnabledTextBox
    Me.txtEndereco.BackColor = corEnabledTextBox
    Me.txtCidade.BackColor = corEnabledTextBox
    Me.txtRegiao.BackColor = corEnabledTextBox
    Me.txtCEP.BackColor = corEnabledTextBox
    Me.txtPais.BackColor = corEnabledTextBox
    Me.txtTelefone.BackColor = corEnabledTextBox
    Me.txtFax.BackColor = corEnabledTextBox
    Me.txtHomePage.BackColor = corEnabledTextBox
End Sub
Private Sub DesabilitaControles()
   'Me.txtCodigoFornecedor.Locked = True
    Me.txtNomeEmpresa.Locked = True
    Me.txtNomeContato.Locked = True
    Me.txtCargoContato.Locked = True
    Me.txtEndereco.Locked = True
    Me.txtCidade.Locked = True
    Me.txtRegiao.Locked = True
    Me.txtCEP.Locked = True
    Me.txtPais.Locked = True
    Me.txtTelefone.Locked = True
    Me.txtFax.Locked = True
    Me.txtHomePage.Locked = True

    Me.txtNomeEmpresa.BackColor = corDisabledTextBox
    Me.txtNomeContato.BackColor = corDisabledTextBox
    Me.txtCargoContato.BackColor = corDisabledTextBox
    Me.txtEndereco.BackColor = corDisabledTextBox
    Me.txtCidade.BackColor = corDisabledTextBox
    Me.txtRegiao.BackColor = corDisabledTextBox
    Me.txtCEP.BackColor = corDisabledTextBox
    Me.txtPais.BackColor = corDisabledTextBox
    Me.txtTelefone.BackColor = corDisabledTextBox
    Me.txtFax.BackColor = corDisabledTextBox
    Me.txtHomePage.BackColor = corDisabledTextBox
End Sub
Private Sub HabilitaBotoesAlteracao()
'habilita os botões de alteração
    optAlterar.Enabled = True
    optExcluir.Enabled = True
    optNovo.Enabled = True
    btnPesquisar.Enabled = True
    btnOK.Enabled = False
    btnCancelar.Enabled = False
    'limpa os valores dos controles
    optAlterar.Value = False
    optExcluir.Value = False
    optNovo.Value = False
End Sub
Private Sub DesabilitaBotoesAlteracao()
'desabilita os botões de alteração
    optAlterar.Enabled = False
    optExcluir.Enabled = False
    optNovo.Enabled = False
    btnPesquisar.Enabled = False
    btnOK.Enabled = True
    btnCancelar.Enabled = True
End Sub
Private Sub HabilitaBotoesNavegaçao()
    btnPrimeiro.Enabled = True
    btnAnterior.Enabled = True
    btnProximo.Enabled = True
    btnUltimo.Enabled = True
End Sub
Private Sub DesabilitaBotoesNavegaçao()
    btnPrimeiro.Enabled = False
    btnAnterior.Enabled = False
    btnProximo.Enabled = False
    btnUltimo.Enabled = False
End Sub


Agradeço qualquer ajuda.
Fiquem com Deus.
Avatar do usuário
ACG
Membro
Membro
 
Mensagens: 6
Registrado em: Sex Nov 10, 2017 3:49 pm
Has thanked: 1 time
Have thanks: 0 time

{ SO_SELECT }

Re: Conexão Banco de Dados Access Arquivo accdb  [Resolvido]

Mensagempor rlm » Qua Set 11, 2019 9:47 pm

O "motor" de conexão é outro
experimente alterar a linha
Código: Selecionar todos
nConectar = "Provider=Microsoft.Jet.oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Base.mdb"

Para
Código: Selecionar todos
nConectar = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Base.accdb"

Fonte: https://www.connectionstrings.com/access/ / https://www.connectionstrings.com/microsoft-jet-ole-db-4-0/
Reinaldo - RLM - Rmarco
Gostou da resposta? Clique no ícone "Positivo" da mensagem!(ao lado de citar)
Avatar do usuário
rlm
Ninja do Excel
Ninja do Excel
 
Mensagens: 325
Registrado em: Qui Out 16, 2014 12:30 pm
Has thanked: 24 times
Have thanks: 151 times


Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Google [Bot], Google Feedfetcher e 6 visitantes