Erro 6160 "Data access error"

[Marco Canhoto]

Olá a todos!

Estou desenvolvendo uma aplicação em VB6 com banco de dados Mysql, que visa o controle de visitantes pela portaria.

Eu desenvolvi o formulário principal, onde são incluidas, alteradas, excluidas e finalizadas as movimentações de entrada e saida. Além desse formulário, há um outro exclusivo para cadastro dos visitantes. Ambos os formulários usam um dataGrid, onde eu clico em algum registro e em seguida clico em algum botão (alterar, excluir, visualizar), onde abre um formulário com os campos.

O problema é que, na parte de movimentações, funciona perfeitamente e para a parte de cadastro de visitantes, eu apenas COPIEI E COLEI os códigos, substituindo apenas os recordsets, uma vez que até os campos são os mesmos. Mesmo tendo código idêntico o cadastro de visitantes não funciona corretamente. A inclusão está Ok, mas as funções de alteração, exclusão e visualização (onde os campos do datagrid são transportados para os campos do formulario secundario) acusam o erro 6160 'Data access error'.

Já mudei o nome do campo, já mudei a conexão, já tentei criar o formulario de novo, mas nada resolve. O projeto simplesmente empacou porque não faço idéia do que pode ser. Abaixo envio os códigos.

Conexão com as tabelas de visitas e visitantes.

Option Explicit

Public Const caminho As String = "c:/fotos/"
Public arquivo As String

Public cn As New ADODB.Connection
Public cmd As New ADODB.Command
Public rs As New ADODB.Recordset
Public cmd1 As New ADODB.Command
Public rs1 As New ADODB.Recordset
Public sql As String

Public Sub carrega()

If cn.State = adStateOpen Then cn.Close

cn.Open "DSN=teste"

sql = "SELECT * FROM visitante"

With cmd1
      Set .ActiveConnection = cn
      .CommandType = adCmdText
      .CommandText = sql
End With

With rs1
   .LockType = adLockPessimistic
   .CursorType = adOpenKeyset
   .CursorLocation = adUseClient
   .Open cmd1
End With

sql = "SELECT * FROM visita"

With cmd
      Set .ActiveConnection = cn
      .CommandType = adCmdText
      .CommandText = sql
End With

With rs
   .LockType = adLockPessimistic
   .CursorType = adOpenKeyset
   .CursorLocation = adUseClient
   .Open cmd
End With

End Sub

Agora o código do formulário que contem o DataGride não está funcionando

Private Sub alterar_Click()

With cadvisit

    For Each ctrl In cadvisit
        If TypeOf ctrl Is TextBox Or TypeOf ctrl Is ComboBox Then
        ctrl.ForeColor = vbBlue
        End If
    Next
    
    .Caption = "Alteração de registro"
    .Frame1.Enabled = True
    .empresa.Text = dg.Columns.Item(0) & ""
    .nome.Text = dg.Columns.Item(1) & ""
    .documento.Text = dg.Columns.Item(2) & ""
    .endereco.Text = dg.Columns.Item(3) & ""
    .cidade.Text = dg.Columns.Item(4) & ""
    .estado.Text = dg.Columns.Item(5) & ""
    .telefone.Text = dg.Columns.Item(6) & ""
    .email.Text = dg.Columns.Item(7) & ""
    .obs.Text = dg.Columns.Item(8) & ""
    
    arquivo = Dir(caminho & dg.Columns.Item(4) & ".jpg")
    
    If arquivo = dg.Columns.Item(4) & ".jpg" Then
        .imagem.Picture = LoadPicture(caminho & arquivo)
    End If
    
    .registro.Caption = dg.Columns.Item(9)
    .Show vbModal

End With

End Sub

Private Sub excluir_Click()

On Error Resume Next

With cadvisit

    For Each ctrl In cadvisit
        If TypeOf ctrl Is TextBox Or TypeOf ctrl Is ComboBox Then
            ctrl.ForeColor = vbRed
        End If
    Next
    .Caption = "Exclusão de registro"
    .empresa.Text = dg.Columns.Item(0) & ""
    .nome.Text = dg.Columns.Item(1) & ""
    .documento.Text = dg.Columns.Item(2) & ""
    .endereco.Text = dg.Columns.Item(3) & ""
    .cidade.Text = dg.Columns.Item(4) & ""
    .estado.Text = dg.Columns.Item(5) & ""
    .telefone.Text = dg.Columns.Item(6) & ""
    .email.Text = dg.Columns.Item(7) & ""
    .obs.Text = dg.Columns.Item(8) & ""
    
    arquivo = Dir(caminho & .documento.Text & ".jpg")
    
    If arquivo = .documento.Text & ".jpg" Then
        .imagem.Picture = LoadPicture(caminho & arquivo)
    End If
    
    .registro.Caption = dg.Columns.Item(9)
    .Show

End With

If MsgBox("Excluir registro?", vbYesNo, "Atenção") = vbYes Then
    
    If rs1.State = adStateOpen Then rs1.Close
    
    rs1.Open "delete from visitante where registro = '" & cadvisit.registro.Caption & "'"
    
    rs1.Open "select * from visitante where documento = '" & cadvisit.documento.Text & "'"
    
    If rs1.EOF And cadvis.imagem.Picture <> 0 Then Kill caminho & arquivo
    
    Form_Load

End If

Unload cadvisit

End Sub

Private Sub Form_Load()

atualiza

End Sub

Private Sub Form_Unload(Cancel As Integer)

cn.Close

End Sub

Private Sub incluir_Click()

arquivo = ""

With cadvisit
    .Caption = "Inclusão de visita"
    .Show vbModal
End With
    
End Sub

Private Sub sair_Click()

Unload Me

End Sub

Public Sub atualiza()

carrega

Set Me.dg.DataSource = rs1

formata

End Sub

Public Sub formata()

dg.Columns(9).Visible = False

If rs1.RecordCount = 0 Then
    visualizar.Enabled = False
    alterar.Enabled = False
    excluir.Enabled = False
Else
    visualizar.Enabled = True
    alterar.Enabled = True
    excluir.Enabled = True
End If



End Sub

Private Sub visualizar_Click()

With cadvisit
    .Caption = "Visualização de registro"
    .gravar.Enabled = False
    .Frame1.Enabled = False
    .empresa.Text = dg.Columns.Item(0) & ""
    .nome.Text = dg.Columns.Item(1) & ""
    .documento.Text = dg.Columns.Item(2) & ""
    .endereco.Text = dg.Columns.Item(3) & ""
    .cidade.Text = dg.Columns.Item(4) & ""
    .estado.Text = dg.Columns.Item(5) & ""
    .telefone.Text = dg.Columns.Item(6) & ""
    .email.Text = dg.Columns.Item(7) & ""
    .obs.Text = dg.Columns.Item(8) & ""
    
    arquivo = Dir("c:/fotos/" & .documento.Text & ".jpg")
    
    If arquivo = .documento.Text & ".jpg" Then
        .imagem.Picture = LoadPicture("c:/fotos/" & arquivo)
    End If

    .registro.Caption = dg.Columns.Item(9)
    .Show vbModal

End With

End Sub

Desde já, agradeço!!!

[kuroi]

marco, qual a linha do erro??

[Marco Canhoto]

Na exclusão, alteração e viazualização, aponta sempre para a linha:

.empresa.Text = dg.Columns.Item(0) & ""

Me parece que o erro acontece quando os campos do datagrid vão ser transportados para os campos do formulario, pois na inclusão (onde não há o preenchimento de campos) não acontece o erro.