Tem Como uma sub do access para o VB6

[Flecha]

Olá,

Tenho a sub abaixo no access para testar se uma tabela já tem um registro que quero incluir.

'Verifica se o Registro existe no Morto caso exista não executa o Arquivo, pois dará Duplicidade
Dim IDsEncontrados As Recordset
   If Not IsNull(Me.RG) Then
      strSQL = " SELECT rg FROM tabela2 WHERE rg = " & Me.RG & ""
      Set IDsEncontrados = CurrentDb.OpenRecordset(strSQL)
   End If
      
   If IDsEncontrados.RecordCount <> 0 Then ' Encontrou RG no Morto
         MsgBox "Esse Registro já existe no morto, vou abrir a ficha do Morto!!" & Chr(13) & "E nela você deverá excluir o registro desse RG" & Chr(13) & " e depois repetir a operação de Arquivar no Morto, OK ?", vbInformation, "Aviso já existe no Morto"
          DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg")
          Exit Sub
      Else
      MsgBox "Pode arquivar no morto que não tem duplicidade", vbInformation, " Aviso"
   'End If
   End If

Tenho a sub abaixo em um projeto VB6 para incluir o registro em outra tabela (ela não verifica se já existe na outra) se tiver dá erro.

Private Sub Arquivar_Click()
   
    Dim strNOME    As String
    Dim strRG     As String
    Dim lngCustID       As Long
    Dim lngNewSelIndex  As Long
    
    If lvwCustomer.SelectedItem Is Nothing Then
        MsgBox "Não tem Nome selecionado para Arquivar.", _
               vbExclamation, _
               "ARQUIVAR - MORTO"
        Exit Sub
    End If
    
    With lvwCustomer.SelectedItem
        strNOME = .text
        strRG = .SubItems(mlngCUST_RG_IDX)
        lngCustID = CLng(.SubItems(mlngCUST_ID_IDX))
    End With
    
    If MsgBox("Você tem certeza que quer Arquivar Nome '" _
            & strNOME & " " & strRG & "'?", _
              vbYesNo + vbQuestion, _
              "Confirma Exclusão") = vbNo Then
        Exit Sub
    End If
    
    mobjCmd.CommandText = "INSERT INTO Morto SELECT * FROM Customer WHERE  CustID = " & lngCustID
    mobjCmd.Execute
    
    mobjCmd.CommandText = "DELETE FROM Customer WHERE CustID = " & lngCustID
    mobjCmd.Execute
    
    With lvwCustomer
        If .SelectedItem.Index = .ListItems.Count Then
            lngNewSelIndex = .ListItems.Count - 1
        Else
            lngNewSelIndex = .SelectedItem.Index
        End If
        .ListItems.Remove .SelectedItem.Index
        If .ListItems.Count > 0 Then
            Set .SelectedItem = .ListItems(lngNewSelIndex)
            lvwCustomer_ItemClick .SelectedItem
        Else
            ClearCurrRecControls
        End If
    End With


' Informa o total de registros do bd

    Set mobjRst = New ADODB.Recordset
    mobjRst.CursorLocation = adUseClient
    mobjRst.Open "Select * From Customer", mobjConn, adOpenKeyset, adLockOptimistic, adCmdText
    Label25.Caption = "Total de Registros = " & mobjRst.RecordCount

End Sub

Na General declarations esta assim

Option Explicit

Private mobjConn                As ADODB.Connection
Private mobjCmd                 As ADODB.Command
Private mobjRst                 As ADODB.Recordset

Como faço para incluir a sub do access no inicio da sub arquivar para fazer a verificação antes de prosseguir com a inclusão e não dar o erro?

Os comandos da sub do access tem que ser modificados? qual os comando que tem que ser trocados para o vb reconhecer?

Obrigado

Flecha

Editado Março 26, 2010 por Flecha

[raphael_suporte]

a principio o código da sub do access está correto.

Cria como se fosse uma function e coloca para ser chamado na sub que deseja.

o código da Function pode ser esse mesmo

[Flecha]

Olá Raphael,

Cadê o Kuroi?

Quanto a sua proposta coloquei assim como sub

Private Function ver_dupli()
'Verifica se o Registro existe no Morto caso exista não executa o Arquivo, pois dará Duplicidade
Dim IDsEncontrados As Recordset
Dim strsql As String
   If Not IsNull(Me.txtRg) Then
      strsql = " SELECT custid FROM tabela2 WHERE txtid = " & Me.TxtID & ""
      Set IDsEncontrados = mobjConn.OpenRecordset(strsql)
   End If
      
   If IDsEncontrados.RecordCount <> 0 Then ' Encontrou RG no Morto
         MsgBox "Esse Registro já existe no morto, vou abrir a ficha do Morto!!" & Chr(13) & "E nela você deverá excluir o registro desse RG" & Chr(13) & " e depois repetir a operação de Arquivar no Morto, OK ?", vbInformation, "Aviso já existe no Morto"
          Morto.Show ' DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg")
          Exit Function
      Else
      MsgBox "Pode arquivar no morto que não tem duplicidade", vbInformation, " Aviso"
   
   End If
End Function

Está retornando erro na linha abaixo (eu troquei por morto.show só para testar a função,) preciso trocar a linha abaixo

DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg")

como passo ela para vb6 a linha acima?

Tem que fazer isso:

tem que abrir (show)o form "morto" com os dados da tabela2 onde o custID (atual) é igual ao custID da tabela2 localizada (duplicidade)

Esta dando erro 3001

Os argumentos são incorretos, estão fora do intervalo aceitavel ou estão em conflito.

nessa linha ----> Set IDsEncontrados = mobjConn.OpenRecordset(strsql)

Como saio dessa?

Flecha

Editado Março 31, 2010 por Flecha

[raphael_suporte]

Olá Raphael,

Cadê o Kuroi?

Quanto a sua proposta coloquei assim como sub

Private Function ver_dupli()
'Verifica se o Registro existe no Morto caso exista não executa o Arquivo, pois dará Duplicidade
Dim IDsEncontrados As Recordset
Dim strsql As String
   If Not IsNull(Me.txtRg) Then
      strsql = " SELECT custid FROM tabela2 WHERE txtid = " & Me.TxtID & ""
      Set IDsEncontrados = mobjConn.OpenRecordset(strsql)
   End If
      
   If IDsEncontrados.RecordCount <> 0 Then ' Encontrou RG no Morto
         MsgBox "Esse Registro já existe no morto, vou abrir a ficha do Morto!!" & Chr(13) & "E nela você deverá excluir o registro desse RG" & Chr(13) & " e depois repetir a operação de Arquivar no Morto, OK ?", vbInformation, "Aviso já existe no Morto"
          Morto.Show ' DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg")
          Exit Function
      Else
      MsgBox "Pode arquivar no morto que não tem duplicidade", vbInformation, " Aviso"
   
   End If
End Function

Está retornando erro na linha abaixo (eu troquei por morto.show só para testar a função,) preciso trocar a linha abaixo DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg") como passo ela para vb6 a linha acima?

você não precisa do DoCmd, para chamar outro form. basta usar o comando Form.Show o que você pode fazer e cirar uma função do form morto, para que ele exiba os dados

Tem que fazer isso: tem que abrir (show)o form "morto" com os dados da tabela2 onde o custID (atual) é igual ao custID da tabela2 localizada (duplicidade) Esta dando erro 3001 Os argumentos são incorretos, estão fora do intervalo aceitavel ou estão em conflito. nessa linha ----> Set IDsEncontrados = mobjConn.OpenRecordset(strsql) Como saio dessa? Flecha

pode ser o jeito que você está abrindo conexão. tente usar esse código para abrir, vou usar como se fosse a function no form Morto, onde você iria chamar assim

form.show
form.MostraDadosCliente

Public Sub MostraDadosCliente(ValID as int)

  Dim rs As New ADODB.Recordset
  Dim SQL As String

  On Error Resume Next
  
  SQL = "SELECT * From Tabela2 Where ID2=" & ValID
  
  rs.Open SQL, cnSQL, adOpenForwardOnly, adLockReadOnly

'cnSQL é sua string de conexão com o banco
  
  txtNome = rs(0)
  txtEndereco = rs(1)
  txtBairro = rs(2)
  txtCidade = rs(3)
  cboEstado = rs(4)
'Assim conforme sua necessidade, lembrando que o retorno do recordser começa do 0, para o primeiro campo da tabela e por ai vai

rsPaciente.Close

End Sub