Acesso a tabela access pelo vba excel em rede

Question

Tenho uma tabela em access gravada em um servidor, que deve ser acessada pelo vba excell. Como devo definir o path da tabela se o servidor tem logon e senha? Será algo como //servidor/diretorio,logon, senha?

grato

 

Answer 1

Olá Crfa segue o código abaixo, não se esqueça de ativar o Microsoft Activex Data Objects 2.5 Library ou versão superior

 

    Set Conn = New ADODB.Connection

    Dim sql As String

    Caminho = ThisWorkbook.Path & "\"

    With Conn

        .Provider = "Microsoft.JET.OLEDB.4.0"

        .Open ("Data Source =" & Caminho & "BD - K&S.mdb;Jet OLEDB:Database Password=SIGM@1!")

    End With

 

   For i = 2 To U_L

            Chave = Sheet2.Range("D" & i)

           

            sql = "UPDATE Base_Queijo AS B SET B.CPP = " & CPP & ", B.Coliformes = " & Coliformes & ", B.Bolores = " & Bolores & ", B.Leveduras = " & Leveduras & ", B.Qualidade2 = " & Qualidade2 & ", B.Situacao_Micro = '" & Situacao1 & "' WHERE B.Chave_Final = '" & Chave & "';"

            Debug.Print sql

            Set rst = New ADODB.Recordset

            With rst

                .ActiveConnection = Conn

                .Open sql, Conn, adOpenDynamic, adLockBatchOptimistic

            End With

            Set rst = Nothing

    Next

    Conn.Close

 

Abraços,

---

Baldini Fabio

Answer 2

Obrigado Baldini,

 

Funcionou otimamente!

 

Carlos

Answer 3

Colega estou com um proble e eu nao sei como resolver, o erro está em negrito

Sub Connect()
Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
con.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = C:\Documents and Settings\00281166\Desktop\Laercio\oee2000.mdb"
rs.LockType = adLockOptimistic             (colega a minha conexao da erro nesta linha e eu nao sei oque é
rs.CursorType = adOpenDynamic
End Sub
Sub Disconnect()
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub

Private Sub novo_Click()
Connect
rs.Open "SELECT linhas FROM cad_linhas ", con
rs.AddNew
Disconnect
End Sub

Private Sub salvar_Click()
Connect

rs.Fields("linhas") = cad_linha.Text
rs.Update
Disconnect
End Sub