No botão salvar, verifica todos os campos do registro e insere numa tabela histórico apenas os campos modificados.

Colegas mais experientes, peço ajuda.

Usando o código abaixo se um registro sofrer alterações o sistema insere numa tabela historico todos os dados daquele registro.

Private Sub btsalvar_Click()

If Me.Form.Dirty = True Then
Me!DHNow.Value = Now
DoCmd.RunCommand acCmdSaveRecord
CurrentDb.Execute "INSERT INTO Tab_Hist (Cod_Registro, Data_Alteracao, Nome, Data, Detalhes) VALUES (" & Código.Value & ", '" & DHNow.Value & "', '" & txt_Nome.Value & "', '" & txt_Data.Value & "', '" & txt_Detalhes.Value & "')"
End If

End Sub

O problema é que se forem muitos campos e apenas 1 foi alterado o código atual vai inserir todos os campos na tabela historico e depois fica dificil identificar qual campo foi alterado, e ainda tem campos Memorando que queria evitar de replicar sem necessidade.

Assim, preciso de uma sugestão para salvar apenas o Cod_Registro, Data_Alteracao que seriam campos padrão e 1 ou mais campos que foram modificados, mas queria no botão salvar ou em uma function ou modulo ativada no botao salvar, pois se usar (por exemplo) no got_focus eu teria de colar esse código campo por campo e iria gerar vários registros para uma mesma alteração.

Segue anexo um bd de teste.

ps. O campo usuário eu já sei salvar, não coloquei aí pra não ter de fazer um sistema login.

Ngm?

Eu uso essa função:

Código:

'Função responsável em salvar as alterações realizadas pelo usuário
'ao abrir... call fnc_alt_log(1,"tb_clientes","codigo","258","1")
Public Function fnc_alt_log(iTipo As Integer, sTabela As String, scampo As String, sChave As String, sTpCriterio As Integer)

1   On Error GoTo Erro

   Dim sCriterio As String
   Dim sCriterio1 As String
   Dim rec As dao.Recordset
   Dim rec1 As dao.Recordset
   Dim fld As dao.Field
   Dim sSQL As String
   Dim sAlteracoes As String
   
   'Verifica se foi repassado as variáveis
2   If IsNull(iTipo) Or iTipo = 0 Then
3       Exit Function
4   End If
5   If IsNull(sTabela) Or sTabela = "" Then
6       Exit Function
7   End If
8   If IsNull(scampo) Or scampo = "" Then
9       Exit Function
10  End If
11  If IsNull(sChave) Or sChave = "" Then
12      Exit Function
13  End If
14  If IsNull(sTpCriterio) Or sTpCriterio = 0 Then
15      Exit Function
16  End If

   'Monta o critério
17  If sTpCriterio = 1 Then     'Numeric
18      sCriterio = "Where " & scampo & "=" & sChave & ""
19      sCriterio1 = scampo & "=" & sChave & ""
20  ElseIf sTpCriterio = 2 Then    'Texto
21      sCriterio = "Where " & scampo & "='" & sChave & "'"
22      sCriterio1 = scampo & "='" & sChave & "'"
23  End If

   'Se 1, início do processo
24  If iTipo = 1 Then
       'Se a(s) tabela(s) existir(em), deleta
25      If existe("log_" & sTabela) Then
26          DoCmd.DeleteObject acTable, "log_" & sTabela
27      End If
       'Cria uma tabela
28      CurrentDb.Execute "Create Table log_" & sTabela
29      CurrentDb.Execute "Alter Table log_" & sTabela & " Add Campos String(255)"
30      CurrentDb.Execute "Alter Table log_" & sTabela & " Add Valor1 Memo"
31      CurrentDb.Execute "Alter Table log_" & sTabela & " Add Valor2 Memo"
32      CurrentDb.Execute "Alter Table log_" & sTabela & " Add Diferente Bit"
       'Atualiza a listagem das tabelas
33      CurrentDb.TableDefs.Refresh
       'Salva o valor inicial do(s) campo(s)
34      Set rec = CurrentDb.OpenRecordset("SELECT * From " & sTabela & " " & sCriterio & "", dbOpenSnapshot)
35      Set rec1 = CurrentDb.OpenRecordset("log_" & sTabela, dbOpenDynaset, dbFailOnError + dbSeeChanges)
36      If Not rec.EOF Then
37          For Each fld In rec.Fields
38              rec1.AddNew
39              rec1("Campos") = fld.Name
40              rec1("Valor1") = Nz(fld.value, "")
41              rec1.Update
42          Next
43      End If
44      Set rec = Nothing
45      Set rec1 = Nothing
       'Se 2, fim do processo
46  ElseIf iTipo = 2 Then
       'Se a(s) tabela(s) não existir
47      If existe("log_" & sTabela) = False Then
48          Exit Function
49      End If
       'Salva o valor final do(s) campo(s)
50      Set rec = CurrentDb.OpenRecordset("SELECT * From " & sTabela & " " & sCriterio & "", dbOpenSnapshot)
51      If Not rec.EOF Then
52          For Each fld In rec.Fields
53              sSQL = Empty
54              sSQL = "UPDATE " & "log_" & sTabela & " SET " & "log_" & sTabela & ".Valor2 = '" & Nz(fld.value, "") & "' WHERE (((" & "log_" & sTabela & ".Campos)='" & fld.Name & "'));"
55              CurrentDb.Execute sSQL, dbSeeChanges
56          Next
57      End If
58      Set rec = Nothing
       'Acertar valores true/falso
59      sSQL = Empty: sSQL = "UPDATE " & "log_" & sTabela & " SET " & "log_" & sTabela & ".Valor2 = '0' WHERE (((" & "log_" & sTabela & ".Valor2)='Falso'));"
60      CurrentDb.Execute sSQL, dbSeeChanges
61      sSQL = Empty: sSQL = "UPDATE " & "log_" & sTabela & " SET " & "log_" & sTabela & ".Valor2 = '-1' WHERE (((" & "log_" & sTabela & ".Valor2)='True'));"
62      CurrentDb.Execute sSQL, dbSeeChanges
       'Define quais campos sofreram alteração
63      sSQL = Empty: sSQL = "UPDATE " & "log_" & sTabela & " SET " & "log_" & sTabela & ".Diferente = True WHERE ((([Valor1]<>[Valor2])=-1));"
64      CurrentDb.Execute sSQL, dbSeeChanges
       'Salva no log definitivo do sistema
65      sSQL = Empty
66      sSQL = "SELECT"
67      sSQL = sSQL & " log_" & sTabela & ".Campos,"
68      sSQL = sSQL & " log_" & sTabela & ".Valor1,"
69      sSQL = sSQL & " log_" & sTabela & ".Valor2,"
70      sSQL = sSQL & " log_" & sTabela & ".Diferente"
71      sSQL = sSQL & " FROM log_" & sTabela & ""
72      sSQL = sSQL & " WHERE (((log_" & sTabela & ".Diferente)=True));"
73      Set rec = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
74      If Not rec.EOF Then
75          rec.MoveFirst
76          Do Until rec.EOF
77              sAlteracoes = sAlteracoes & rec("Campos") & ": " & rec("Valor1") & " | " & rec("Valor2") & ";" & vbCrLf
78              rec.MoveNext
79          Loop
80      End If
81      Set rec = Nothing
82      Call fnc_ins_log(sTabela, sChave, "ALTERAÇÃO: " & vbCrLf & Replace(sAlteracoes, "'", ""))
       'Se 3, fim do processo
83  ElseIf iTipo = 3 Then
       'Se a(s) tabela(s) não existir
84      If existe("log_" & sTabela) = False Then
85          Exit Function
86      End If
       'Verifica se o registro foi excluído
87      If DCount(scampo, sTabela, sCriterio1) < 1 Then
           'Salva os dados excluídos no log
88          sSQL = Empty
89          sSQL = "SELECT"
90          sSQL = sSQL & " log_" & sTabela & ".Campos,"
91          sSQL = sSQL & " log_" & sTabela & ".Valor1,"
92          sSQL = sSQL & " log_" & sTabela & ".Valor2,"
93          sSQL = sSQL & " log_" & sTabela & ".Diferente"
94          sSQL = sSQL & " FROM log_" & sTabela & ""
95          Set rec = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
96          If Not rec.EOF Then
97              rec.MoveFirst
98              Do Until rec.EOF
99                  sAlteracoes = sAlteracoes & rec("Campos") & ": " & rec("Valor1") & ";" & vbCrLf
100                 rec.MoveNext
101             Loop
102         End If
103         Set rec = Nothing
104         Call fnc_ins_log(sTabela, sChave, "EXCLUSÃO: " & vbCrLf & Replace(sAlteracoes, "'", ""))
105     End If
106 End If

   '...
107 On Error GoTo 0
108 Exit Function
Erro:
109 DoCmd.Hourglass False
110 MsgBox "Ocorreu um erro na aplicação." & vbCr & _
          "Relate os dados abaixo ao suporte." & vbCr & _
          "Erro nº: " & Err.Number & vbCr & _
          "Descrição do erro: " & Err.Description & vbCr & _
          "Módulo: Parametros_Cnf " & vbCr & _
          "Procedimento: fnc_alt_log " & vbCr & _
          "Linha: " & Erl & ".", vbCritical, "ATENÇÃO !"
         
End Function

antes de excluir...
Call fnc_alt_log(3, "tb_medicos", "codigo", sCodigo, "1")

após salvar...
Call fnc_alt_log(2, "tb_medicos", "codigo", Form_frmMedicos.codigo, "1")

ao editar...
Call fnc_alt_log(1, "tb_medicos", "codigo", Form_frmMedicos.codigo, "1")