Olá,
Tenho uma sub abaixo para retirar o registro que esta no form na tabela "vivo" e arquivar na tabela "morto" e em seguida deletar da tabela " Vivo".
O indice nas duas tabelas é o campo "RG" não aceita duplicação.
Então quando for arquivar na tabela "morto" e existir o RG lá, vai dar o erro.
Esta acontecendo o seguinte:
Se não tem o RG no Morto esta efetuando o arquivo do registro do form na tabela morto e deletando da tabela Vivo. Normal.
Se já existe o RG na tabela Morto a sub não completa a execução, até pergunta se tem certeza de quer arquivar no morto o fulano, e clicando em sim volta a tela do form com o cara lá, "não fez nada", não arquivou e não deu a mensagem que já tem ele no morto"
O que está errado na minha sub?
Não passa na MSGBOX para informar.
Gostaria de colocar quando deu certo a mensagem "Registro arquivado com sucesso"
Minha sub:
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
'On Error GoTo erro_mdb 'inicia o tratamento de erros
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
On Error GoTo erro_mdb 'inicia o tratamento de erros
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
'-------------
erro_mdb:
If Error = "0" Then Resume Next '"2147467259" Then
If Error = "2147467259" Then
MsgBox "Erro número : " & Str$(Err.Number) & " --> RG já Existe no Morto !!! " & Chr(13) _
& "Favor verificar no Morto pelo RG e confirmar a duplicidade " & Chr(13) _
& " se é o mesmo do que esta no Vivo. NÃO PODE HAVER (RG) IGUAL" _
& Chr(13) & "DO MORTO NO VIVO e Vice-Versa " _
& Chr(13) & "Operação Cancelada"
'Resume Next 'retorna a ação para a linha de código subsequente áquela que
'gerou o erro
End If
End Sub
Flecha
