Controle de Acesso - Parte 2

[angelthrone 0]

Eu tou a tentar duplicar o codigo , do Controle de Acesso - Parte 2 , e da-me erro "3709" e se fizer debug , vai -me para esta linha ".Open "select * from Utilizadores order by User", cn, adOpenKeyset, adLockOptimistic"

 

 

O meu codigo

"modulo modCnn"

Option Explicit

 

Global cn As ADODB.Connection

Global rs As ADODB.Recordset

Private Sub Main()

Dim strArquivo As String

Dim strLocal As String

Dim ConectaAccess As String

 

DoEvents

Set cn = New ADODB.Connection

Set rs = New ADODB.Recordset

 

strArquivo = "Final.mdb"

strLocal = App.Path

Set cn = CreateObject("ADODB.Connection")

ConectaAccess = "Driver={Microsoft Access Driver (*.mdb)};" & _

"Dbq=" & strArquivo & ";" & _

"DefaultDir=" & strLocal & ";" & _

"Uid=Admin;Pwd=;"

 

cn.Open ConectaAccess

 

Load Form1

Form1.Show

End Sub

 

 

E a form

 

Private Sub desliga()

TxtUtilizador.Locked = True

TxtNome.Locked = True

TxtDpto.Locked = True

TxtCargo.Locked = True

TxtPass.Locked = True

CmdApagar.Enabled = False

CmdActualizar.Enabled = False

End Sub

Private Sub Disponiveis()

TxtUtilizador.Locked = False

TxtNome.Locked = False

TxtDpto.Locked = False

TxtCargo.Locked = False

TxtPass.Locked = False

CmdApagar.Enabled = True

CmdActualizar.Enabled = True

End Sub

Private Sub limpar()

codUtilizador = 0

TxtUtilizador.Text = ""

TxtNome.Text = ""

TxtDpto.Text = ""

TxtCargo.Text = ""

TxtPass.Text = ""

End Sub

Private Sub CmdActualizar_Click()

' Actualizar e modificar os utilizadores

If CmdActualizar.Caption = "&Incluir" Then

cn.Execute ("insert into Utilizadores(Utilizador,nome,dpto,cargo,Password)" _

& "values('" & TxtUtilizador.Text & "','" & TxtNome.Text & "'," _

& "'" & TxtDpto.Text & "','" & TxtCargo.Text & "','" & TxtPass.Text & "')")

MsgBox "inclusão concluída com sucesso.", vbExclamation

Else

cn.Execute "update Utilizadores set Utilizador= '" & TxtUtilizador.Text & "', " _

& "nome= '" & TxtNome.Text & "', dpto= '" & TxtDpto.Text & "', " _

& "cargo= '" & TxtCargo.Text & "', senha= '" & TxtPass.Text & "'" _

& " where Cod_utilizador = " & codUtilizador

MsgBox "Atualização concluida com sucesso.", vbExclamation

End If

Call limpar

Call desliga

Call clista

End Sub

Private Sub CmdApagar_Click()

' Apagar dados do Utilizador

Private Sub cmdExcluir_Click()

cn.Execute "delete * from Utilizadores where Cod_utilizador=" & codUtilizador

MsgBox "Utilizador Apagado", vbExclamation

Call limpar

Call desliga

Call clista

End Sub

Private Sub CmdSair_Click()

cn.Close

Unload Me

End Sub

 

Private Sub clista()

Dim lstUtiliza As ListItem

 

Set rs = CreateObject("ADODB.Recordset")

With rs

.Open "select * from Utilizadores order by User", cn, adOpenKeyset, adLockOptimistic

 

'Limpar

lslutilizadores.ListItems.Clear

'Carregar

Set lstUtiliza = lslutilizadores.ListItems.Add(, , "<Novo>")

If .EOF Then

MsgBox "Não existe o utilizador", vbExclamation

Else

Do Until rs.EOF

Set lstUtiliza = lslutilizadores.ListItems.Add(, , rs("usuario"))

lstUtiliza.Tag = rs("Cod_utilizador")

lstUtiliza.SubItems(1) = rs("nome")

lstUtiliza.SubItems(2) = rs("dpto")

lstUtiliza.SubItems(3) = rs("cargo")

lstUtiliza.SubItems(4) = rs("Password")

 

rs.MoveNext

Loop

End If

.Close

End With

End Sub

 

Private Sub Form_Load()

Dim codUtilizador As Integer

Call clista

Call limpar

Call desliga

End Sub

Private Sub lslutilizadores_ItemClick(ByVal Item As MSComctlLib.ListItem)

Call Disponiveis

Call limpar

If Item = "<Novo>" Then

CmdActualizar.Caption = "&Incluir"

CmdApagar.Enabled = False

Else

CmdActualizar.Caption = "&Atualizar"

codUtilizador = Item.Tag

TxtUtilizador.Text = Item.Text

TxtNome.Text = Item.SubItems(1)

TxtDpto.Text = Item.SubItems(2)

TxtCargo.Text = Item.SubItems(3)

TxtPass.Text = Item.SubItems(4)

End If

TxtUtilizador.SetFocus

End Sub

 

Alguem me pode ajudar a descobrir o que fiz mal.

 

Também se quiserem tem para dowload aqui o que fiz www.themightpower.org/Extra/teste.rar

[Luizgrs 0]

O que diz esse erro 3709?Sempre coloque o que diz o erro.Estou sem o programa de informações dos Erros... ^^

[angelthrone 0]

O erro é este "run-time 3709: the connection cannot be used to perform this operation. it is either closed or invalid in this context."

[Luizgrs 0]

Você já tentou abrir utilizar o Select dessa maneira:

set rs = cn.execute("select * from Utilizadores order by User")

?

 

E outra coisa, quando você faz assim com as variaveis:

Set cn = New ADODB.ConnectionSet rs = New ADODB.Recordset

Não é necessário fazer isso:

Set cn = CreateObject("ADODB.Connection")Set rs = CreateObject("ADODB.Recordset")