none
PESQUISA ADODB (EXCEL x ACCESS) RRS feed

  • Pergunta

  • Amigos, bom dia!

    Preciso da ajuda de vocês para entender e corrigir um problema que está aparecendo quando tento fazer uma busca num formulário que criei no Excel, num banco de dados do ACCESS. Lembrando que sou bem amador no assunto, então desculpem qualquer erro boçal rsrs

    Informações que podem ser úteis:

    A - Banco de dados (BDGERAL) e formulário (PAINEL_GESTÃO) estão salvos no mesmo local;

    B - Versão do Excel: Microsoft Excel 2013 (15.0.4420.1017) MSO (15.0.4569.1506) 64 bits

    O  erro apresentado é o seguinte:

    Erro em tempo de execução '-2147217865 (80040e37)':

    Erro de automação

    Comandos de conexão:

    Sub Conecta()


    Set Miconexao = New ADODB.Connection

    With Miconexao
    .Provider = "Microsoft.ACE.OLEDB.15.0"
    .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\BDGERAL.accdb"
    .Open

    End With

    End Sub

    Comandos de busca:

    Private Sub cmdPesquisar_Click()

    Set Rs = New ADODB.Recordset
    Rs.Open "SELECT * FROM BASEDADOS where COD ENDERECO = '" & Me.txtCodEndereco.Text & "'", Miconexao, adOpenKeyset, adLockOptimistic, adCmdText

    Me.txtCodcliente.Text = Rs.Fields("COD CLIENTE")
    Me.txtPosicaoMaximo.Text = Rs.Fields("POSICAO MAXIMO")
    Me.txtDocumento.Text = Rs.Fields("CPF/ CNPJ")
    Me.txtChamadoSM.Text = Rs.Fields("CHAMADO S M")
    Me.cbDePara.Text = Rs.Fields("DE/ PARA")
    Me.txtRazaoSocial = Rs.Fields("RAZAO SOCIAL")
    Me.cbPendencias = Rs.Fields("PENDENCIA")
    Me.txtBase = Rs.Fields("BASE INSTALADA")
    Me.txtMaximo = Rs.Fields("MAXIMO")
    Me.txtCC = Rs.Fields("CONTA CORRENTE")
    Me.txtGED = Rs.Fields("GED")
    Me.cbAbastecimento = Rs.Fields("ABASTECIMENTO")
    Me.txtCodBase1 = Rs.Fields("COD BASE 1")
    Me.cbItemBI11 = Rs.Fields("ITEM11")
    Me.txtP11 = Rs.Fields("PERMITIDO 11")
    Me.txtE11 = Rs.Fields("ENVIADO 11")
    Me.cbItemBI12 = Rs.Fields("ITEM21")
    Me.txtP12 = Rs.Fields("PERMITIDO21")
    Me.txtE12 = Rs.Fields("ENVIADO21")
    Me.cbItemBI13 = Rs.Fields("ITEM31")
    Me.txtP13 = Rs.Fields("PERMITIDO31")
    Me.txtE13 = Rs.Fields("ENVIADO31")
    Me.txtCodBase2 = Rs.Fields("COD BASE 2")
    Me.cbItemBI21 = Rs.Fields("ITEM12")
    Me.txtE21 = Rs.Fields("ENVIADO12")
    Me.txtP21 = Rs.Fields("PERMITIDO12")
    Me.cbItemBI22 = Rs.Fields("ITEM22")
    Me.txtP22 = Rs.Fields("PERMITIDO22")
    Me.txtE22 = Rs.Fields("ENVIADO22")
    Me.cbItemBI23 = Rs.Fields("ITEM13")
    Me.txtP23 = Rs.Fields("PERMITIDO32")
    Me.txtE23 = Rs.Fields("ENVIADO32")
    Me.txtCodBase3 = Rs.Fields("COD BASE 3")
    Me.cbItemBI31 = Rs.Fields("ITEM13")
    Me.txtP31 = Rs.Fields("PERMITIDO13")
    Me.txtE23 = Rs.Fields("ENVIADO13")
    Me.cbItemBI11 = Rs.Fields("ITEM23")
    Me.txtP32 = Rs.Fields("PERMITIDO23")
    Me.txtE32 = Rs.Fields("ENVIADO23")
    Me.cbItemBI33 = Rs.Fields("ITEM33")
    Me.txtP33 = Rs.Fields("PERMITIDO33")
    Me.txtE33 = Rs.Fields("ENVIADO33")
    Me.cbItemCC1 = Rs.Fields("ITEM1CC")
    Me.txtQtdeCC1 = Rs.Fields("QTDE1CC")
    Me.cbItemCC2 = Rs.Fields("ITEM2CC")
    Me.txtQtdeCC2 = Rs.Fields("QTDE2CC")
    Me.cbItemCC3 = Rs.Fields("ITEM3CC")
    Me.txtQtdeCC1 = Rs.Fields("QTDE3CC")
    Me.cbItemGED1 = Rs.Fields("ITEM1GED")
    Me.txtQtdeGED1 = Rs.Fields("QTDE1GED")
    Me.cbItemGED2 = Rs.Fields("ITEM2GED")
    Me.txtQtdeGED2 = Rs.Fields("QTDE2GED")
    Me.cbItemGED3 = Rs.Fields("ITEM3GED")
    Me.txtQtdeGED3 = Rs.Fields("QTDE3GED")

    Rs.Update

    End If


    End Sub

    Comando de inicialização:

    Private Sub UserForm_Initialize()

    Call Conecta

    Set Rs = New ADODB.Recordset

    Rs.Open "SELECT * from BDGERAL", Miconexao, adOpenKeyset, adLockOptimistic, adCmdText


    End Sub


    Comando de abertura:

    Private Sub Workbook_Open()
    ActiveWorkbook.Sheets("Saneamento_Empresarial").Visible = False
    ActiveWorkbook.Sheets("INFO").Visible = False
    Dados.Show vbModeless

    End Sub

    terça-feira, 25 de abril de 2017 14:03

Todas as Respostas

  • Meu amigo, no seu botao de Pesquisa, substitua esta linha:

    Rs.Open "SELECT * FROM BASEDADOS where COD ENDERECO = '" & Me.txtCodEndereco.Text & "'", Miconexao, adOpenKeyset, adLockOptimistic, adCmdText [/code]
    Por esta: 

    With Rs .ActiveConnection = Miconexao .CursorType = adOpenKeyset .LockType = adLockOptimistic .Open "SELECT * FROM BASEDADOS where [COD ENDERECO] = " & Me.txtCodEndereco.Text End With

     If Rs.EOF = False Then

    E corrija as referencias dos nomes dos seus campos se tiver alguma inconsistencia 

    terça-feira, 25 de abril de 2017 20:17