Estou com um pequeno erro quando tento cadastrar um contato no meu sistema (desenvolvido em VB6, com banco de dados access).

O erro é o seguinte: "O operação não permitida quando objeto está aberto".

 

O código do form é:

 

Dim CodEmpresa As String

Private Sub CmbEmpresa_Click()
Dim RS As Recordset
Conecta True
Set RS = Conexao.Execute("Select * From TblEmpresa Where Empresa ='" & CmbEmpresa.Text & "'")
If Not RS.EOF Then
CodEmpresa = RS("CodEmpresa")
End If

Conecta False
End Sub

Private Sub CmdCancelar_Click()
    Limpar
    Desabilitar
End Sub

Private Sub CmdIncluir_Click()
    Habilitar
    Limpar
    CmbEmpresa.SetFocus
End Sub

Private Sub CmdOk_Click()
Dim SQL As String
       
    If CmbEmpresa = "" Then
        MsgBox " Selecione uma Empresa ! ", vbInformation
        CmbEmpresa.SetFocus
        Exit Sub
    End If
    If Trim(TxtNome) = "" Then
        MsgBox " Complete o Nome do Contato ! ", vbInformation
        TxtNome.SetFocus
        Exit Sub
    End If
    If Trim(TxtEmail) = "" Then
        MsgBox " Complete o E-mail do Contato ! ", vbInformation
        TxtEmail.SetFocus
        Exit Sub
    End If
   
    Conecta True
    
        Conexao.Execute ("INSERT INTO TblContato(CodEmpresa,Nome,Sobrenome,Email)values('" & CodEmpresa & "','" & TxtNome.Text & "','" & TxtSobrenome.Text & "','" & TxtEmail.Text & "')")
           
    Limpar
    Desabilitar
    Conecta False
End Sub

Private Sub Form_Load()
Dim RS As Recordset
    Desabilitar
    Conecta True
       Set RS = Conexao.Execute("Select * From TblEmpresa")
    If RS.EOF Then
        MsgBox " Não existe empresas cadastradas, cadastre uma empresa antes de prosseguir ! ", vbInformation
        CmdIncluir.Enabled = False
        Conecta False
        Exit Sub
    End If
    
        
    Do While Not RS.EOF
   
        CmbEmpresa.AddItem (RS("Empresa"))
        RS.MoveNext
   
    Loop
        
    Conecta False
End Sub

Public Sub Desabilitar()
    Frame1.Enabled = False
    CmdOk.Enabled = False
    CmdCancelar.Enabled = False
    CmdIncluir.Enabled = True
End Sub

Public Sub Habilitar()
    Frame1.Enabled = True
    CmdOk.Enabled = True
    CmdCancelar.Enabled = True
    CmdIncluir.Enabled = False
End Sub

Public Sub Limpar()
    CmbEmpresa.ListIndex = (-1)
    TxtNome = ""
    TxtSobrenome = ""
    TxtEmail = ""
    CodEmpresa = ""
End Sub

 

 

O módulo é:

 

Public BD As New ADODB.Connection
Public RS As New ADODB.Recordset

 

Option Explicit
Global Conexao As New ADODB.Connection
Public Function Conecta(ByVal Valor As Boolean)

If Valor = True Then
Conexao.Open "provider=microsoft.jet.oledb.4.0;" & _
    "Data source=C:CONTATOS1.mdb;" & _
    "persist security info=false;"
Else

Conexao.Close

Set Conexao = Nothing
End If
End Function

 

 

Desde já agradeço!

Pedro Henrique!

Colega se não me engano fui eu que passei esta forma de conexão pra você bom desde então também deparei com este problema, que é simples, em algum lugar você abriu o banco (Conecta True) e não Fechou (Conecta False) por isso do erro mas veja como contornar, apenas altere no Módulo o seguinte:

 

 

acrescente as linhas que estão em negrito nestas linhas é verificado se você está tentando abrir uma conexão que já esta aberta, e e estiver entao esta conxao é fechada para estebilizar o sistema.

 

Ate

 

Aí diz: "Operação não permitida quando o objeto está fechado" e o erro vai para a linha em negrito.

 

 

Já sei que foi resolvido estarei postando somente a solução, apos o colega irá encerrar.