Problemas de conexão via ADO

[Mauricio Munhoz 0]

Caros Colegas do Forum IMasters,Estou tentando fazer uma conexão simples com um banco de dados Access via ADO e estou recebendo um erro quando executo a seguinte instruções no formulário:If cn.State = adStateClosed Then cn.OpenO programa está bem simples, ainda num passo inicial. Ele possui um módulo com parâmetros de conexão e um formulário que implementa a parte gráfica e algumas funcionalidades.====================== Módulo dbConnect ======================Option Explicit'Módulo de conexão com o Banco de DadosGlobal cn As ADODB.ConnectionGlobal rs As ADODB.RecordsetGlobal strConnect As StringPublic Sub Main()Dim strArquivo As StringDim strLocal As StringDim ConectaAccess As StringLoad frmPrincipalfrmPrincipal.ShowDoEventsSet cn = New ADODB.ConnectionSet rs = New ADODB.RecordsetSet cn = CreateObject("ADODB.Connection")strArquivo = "servidores_supcd.mdb"strLocal = App.PathConectaAccess = "Driver={Microsoft Access Driver (*.mdb)};" & "Dbq=" & strArquivo & ";" & "DefaultDir=" & strLocal & ";" & "Uid=Admin;Pwd=;"cn.Open ConectaAccessstrConnect = ConectaAccessEnd SubPublic Function Consultar(ByVal sBuffer3 As String) As VariantSet rs = CreateObject("ADODB.Recordset")With rs.Open "select * from servidores where nome_servidor=" & sBuffer3 & " or ip_servidor=" & sBuffer3 & "", strConnect, adOpenKeyset, adLockOptimisticIf .RecordCount = 0 ThenMsgBox "Nenhum servidor foi encontrado para o parâmetro de pesquisa mencionado.", vbExclamation, "Erro"Else'carregar a listaDo Until rs.EOFSet lstC = ListView1.ListItems.Add(, , rs("Nome"))lstC.SubItems(1) = rs("IP")lstC.SubItems(2) = rs("Serviços")lstC.SubItems(3) = rs("Máquina")lstC.SubItems(4) = rs("Tipo")lstC.SubItems(5) = rs("Alteração")rs.MoveNextLoopEnd If.CloseEnd WithEnd Function================================================================================== Formulário frmPrincipal ======================Option Explicit'Programa para busca de servidoresPrivate Sub cmdLimpar_Click()txtNome = ""txtIp = ""End SubPrivate Sub cmdPesquisaIp_Click()Dim sBuffer2 As StringLimpa_ListasBuffer2 = Trim(txtNome)Consultar (sBuffer2)End SubPrivate Sub cmdPesquisaNome_Click()Dim sBuffer1 As StringLimpa_ListasBuffer1 = Trim(txtNome)Consultar (sBuffer1)End SubPrivate Sub cmdSair_Click()cn.CloseSet cn = NothingUnload MeEnd SubPrivate Sub CondicaoInicial()'Deixa os botões habilitados/desabilitadoscmdLimpar.Enabled = FalsecmdAtualizar.Enabled = TruecmdSair.Enabled = FalseEnd SubPrivate Sub CondicaoVazia()'Em caso de banco vazio, desabilita os botõescmdLimpar.Enabled = FalsecmdAtualizar.Enabled = FalsecmdSair.Enabled = TruecmdPesquisaNome.Enabled = FalsecmdPesquisaIp.Enabled = FalsecmdPesquisaBox.Enabled = FalseEnd SubPrivate Sub comboBox1_Click()Call Monta_ListaEnd SubPrivate Sub Monta_Lista()Dim lstC As ListItemIf cn.State = adStateClosed Then cn.Open'Limpar ListaListView1.ListItems.ClearWith rs.Open "SELECT * FROM servidores WHERE nome_servidor = '" & comboBox1.Text & "'", strConnect, adOpenKeyset, adLockOptimisticIf .RecordCount = 0 ThenMsgBox "Nã existem clientes no estado selecionado.", vbExclamation, "Erro"CondicaoVaziaElse'carregar a listaDo Until rs.EOFSet lstC = ListView1.ListItems.Add(, , rs("Nome"))lstC.SubItems(1) = rs("IP")lstC.SubItems(2) = rs("Serviços")lstC.SubItems(3) = rs("Máquina")lstC.SubItems(4) = rs("Tipo")lstC.SubItems(5) = rs("Alteração")rs.MoveNextLoopEnd If.CloseEnd WithEnd SubPrivate Sub Form_Load()CondicaoInicialSet cn = CreateObject("ADODB.Connection")Set rs = CreateObject("ADODB.Recordset")If cn.State = adStateClosed Then cn.OpenWith rs.Open "SELECT * FROM servidores", strConnect, adOpenKeyset, adLockOptimisticIf .RecordCount = 0 ThenMsgBox "Nã existem estados cadastrado no sistema.", vbExclamation, "Erro"CondicaoVaziaElsecomboBox1.ClearDo Until rs.EOFcomboBox1.AddItem rs("nome_servidor")rs.MoveNextLoopEnd If.CloseEnd WithEnd SubPrivate Sub Limpa_Lista()ListView1.ListItems.ClearEnd Sub============================================================Recebo a seguinte mensagem de erro:[Microsoft] [ODBC Driver Manager] Nome da fonte de dados não encontrado e nenhum driver padrão especificadoSe alguém puder me ajudar fico imensamente grato.Muito ObrigadoMauricio Munhoz

[Graymalkin 0]

Ao invés de...

 

ConectaAccess = "Driver={Microsoft Access Driver (*.mdb)};" & "Dbq=" & strArquivo & ";" & "DefaultDir=" & strLocal & ";" & "Uid=Admin;Pwd=;"

... experimente fazer:

 

ConectaAccess = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strArquivo

Onde "strArquivo" deve conter o caminho *completo* para o seu arquivo MDB.

 

Abraços,

 

Graymalkin

[Mauricio Munhoz 0]

Prezado Amigo,Tentei fazer essa sugestão, mas o erro ainda permanece...De qualquer forma obrigado por estar me ajudando.AbraçosMauricio Munhoz

[Graymalkin 0]

Experimentou verificar o conteúdo da variável strArquivo para ter certeza de que o caminho do arquivo está certo?Abraços,Graymalkin

[Dennys Lopes 0]

Tente conectar usando isso:

 

oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";JET OLEDB:Database Password=" & strPass & ";"