Bonjour à tous.

Je suis un peu inquièt quand je poste des questions sur les forums d'OC. Car soit on ne me répond pas ou soit on me réponds vraiment mal.

Dans tous les cas, voici mon problème :

J'ai une base de données Acces. Dans cette base j'ai trois tables. J'aimerais pouvoir déplacer les enregistrements de la première table vers la seconde, qui elle, contient exactement les mêmes champs que la première.

La deuxième table me sert d'archivage des éléments de la première.

Comment puis-je réussir à le faire, sachant que l'un des champ de la première table contient des pièces jointes, et c'est pas évident pour moi de les transférer via SQL.

Merci d'avance..

-
Edité par Anonyme 13 novembre 2017 à 12:38:57

Salut,

Qu'entends-tu par "on me réponds vraiment mal" ?

J'entends par là certaines personnes qui au lieu de m'aider me raillent de manière directe ou indirecte.

J'espère que vous n'êtes pas de ce genre ?

Ça fait quand même un bon bout que je suis sur cet plate-forme et reconnais ne pas maîtriser les profondeurs de l'informatique. Mais très souvent les réponses que je reçois de certaines personnes me frustrent où me découragent. J'avais un moment arrêté d'y poster des questions ici, mais je me dis que n'ai pas forcément trop de choix.

En espérant t'avoir éclairé.

Il n'y a pas 36 solutions pour déplacer des données:
- Faire une copie
- Supprimer les données originelles
Soit 2 opérations, ce qui implique une transaction (histoire de garder la base dans un état cohérent en cas de problème).

Les champs de type pièce jointes peuvent être accedés via un objet de type DAO.Recordset2, ensuite c'est de la simple manipulation de l'objet.

Le code ci-dessous repond peut-être à ton besoin:
Public Sub test2()
On Error GoTo Error
    Dim oDb As DAO.Database
    Dim src As DAO.TableDef
    Dim trg As DAO.TableDef
    Dim strSQL As String
    Dim oDbe As DAO.DBEngine
   
    Set oDbe = Application.DBEngine
    Set oDb = CurrentDb
    Set src = oDb.TableDefs("tblSrc")
    Set trg = oDb.TableDefs("tblTrg")
   
    oDbe.BeginTrans
On Error GoTo errTransaction
    copyTable src, trg
    Set trg = Nothing
    Set src = Nothing
   
        '// requete de suppression des lignes d'origine
    strSQL = vbNullString
    strSQL = strSQL & "DELETE tblSrc.*" & vbCrLf
    strSQL = strSQL & "FROM tblSrc" & vbCrLf
    strSQL = strSQL & "WHERE tblSrc.ID In (SELECT ID FROM tblTrg);"
    oDb.Execute strSQL, dbFailOnError
    oDbe.CommitTrans
On Error GoTo Error
    Set oDb = Nothing
    Set oDbe = Nothing
Exit Sub
errTransaction:
    oDbe.Rollback
    GoTo Error
Exit Sub
Error:
    If Not (trg Is Nothing) Then
        Set trg = Nothing
    End If
    If Not (src Is Nothing) Then
        Set src = Nothing
    End If
    If Not (oDb Is Nothing) Then
        Set oDb = Nothing
    End If
    If Not (oDbe Is Nothing) Then
        Set oDbe = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

Public Sub copyTable(ByRef src As DAO.TableDef, ByRef trg As DAO.TableDef)
On Error GoTo Error
    Dim oRsSrc As DAO.Recordset
    Dim oRsTrg As DAO.Recordset
    Dim fld As DAO.Field
   
    Set oRsSrc = src.OpenRecordset(dbOpenSnapshot)
    Set oRsTrg = trg.OpenRecordset(dbOpenDynaset)
    While Not (oRsSrc.EOF)
        oRsTrg.AddNew
        For Each fld In oRsSrc.Fields
                '// champ de destination non auto incrément ?
                '// si oui, on copie
            If ((oRsTrg.Fields(fld.Name).Attributes And dbAutoIncrField) <> dbAutoIncrField) Then
                If (fld.Type <> dbAttachment) Then
                    oRsTrg.Fields(fld.Name).Value = fld.Value
                Else
                        '// champ type piece jointe
                    copyAttachment fld.Value, oRsTrg.Fields(fld.Name).Value
                End If
            End If
        Next
        oRsTrg.Update
        oRsSrc.MoveNext
    Wend
    oRsTrg.Close
    Set oRsTrg = Nothing
    oRsSrc.Close
    Set oRsSrc = Nothing
Exit Sub
Resume
Error:
    If Not (oRsTrg Is Nothing) Then
        If (oRsTrg.EditMode <> dbEditNone) Then
            oRsTrg.CancelUpdate
        End If
        oRsTrg.Close
        Set oRsTrg = Nothing
    End If
    If Not (oRsSrc Is Nothing) Then
        oRsSrc.Close
        Set oRsSrc = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

Private Sub copyAttachment(ByRef src As DAO.Recordset2, trg As DAO.Recordset2)
On Error GoTo Error
    Dim fld As DAO.Field2
   
    trg.AddNew
    For Each fld In src.Fields
        If (fld.DataUpdatable) Then
            trg.Fields(fld.Name).Value = fld.Value
        End If
    Next
    trg.Update
Exit Sub
Resume
Error:
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

Bonjour Deedolith

Merci pour ta contribution. Je viens de tester cela ça marche parfaitement.

Merci énormément pour ta contribution. Que Dieu te bénisse.

-
Edité par Anonyme 14 novembre 2017 à 9:21:54