Copier Champ PIECE_JOINTE de table1 vers un autre champ PIECE_JOINTE de table2

Version imprimable

12/02/2018, 22h32
RaphBdd66

Copier Champ PIECE_JOINTE de table1 vers un autre champ PIECE_JOINTE de table2

Bonsoir,

J'ai consulté les tutos de Mr Warin , merci à lui , sur la manipulation des donnée DAO, Pièces jointes et champs multi valuées.
J' ai effectué diverses tentatives avec du code VBA et recordset2.

J ai l'habitude de travailler avec des tables temporaires pour la saisie de données.
Est-il possible de copier un champ PIECE JOINTE d'une table (temporaire) vers un champ PIECE JOINTE d'une autre table (table maitre) ?

Si oui ,est ce que quelqu'un aurait la gentillesse de m'aiguiller ?

Merci d'avance
12/02/2018, 22h47
loufab

Bonjour,

Je passe pas un savetofile puis un LoadFromFile pour transférer mes pj.

Cordialement,
13/02/2018, 07h28
RaphBdd66

Merci Loufab, :)

Je vais tenter cette méthode.

Cordialement

Raph

Je suis actuellement sur le Tuto de Mr Christophe WARIN, "les pièces jointes par l'exemple" pour me faire la main ,
http://warin.developpez.com/access/piecejointe/

J'ai créé le formulaire basé sur la table "tbl_eleve" et je peux ajouter des pièces jointes au SOUS FORMULAIRE pièces jointes.
Pour ce faire, j'ai du ajouter les lignes oRst.edit et oRst.update du recordset de la table pour que cela fonctionne.

En revanche, difficile pour moi de faire fonctionner le code pour enregistrer une pièce jointe avec cette ligne de commande de "Private Sub cmdEnregistrer_Click".

Code:

                                                                ShellExecute Me.hwnd, "open", strchemin, "", CurrentProject.Path, 1

J' ai pourtant créer le module "mduAPI" comme précisé dans le toto:

Code:

1
2
3
                                                               Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                                              (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                                                               ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Erreur de compilation : le code de ce projet doit être mis à jour pour être utilisé sur les système 64 bits. Vérifiez et mettez à jour les instructions DECLARE, puis marquez les avec l'attributs Ptrsafe.

Pouvez vous m'aider ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub cmdEnregistrer_Click()
Dim strchemin As String
Dim strNomFichier As String
Dim oFD As Object
strNomFichier = Nz(SFormFichier.Form.txtfichier)
If strNomFichier <> "" Then

    'Paramètre la fenêtre Enregistrer
    Set oFD = Application.FileDialog(msoFileDialogSaveAs)
    With oFD
        'Affiche la fenêtre et vérifie qu'un fichier a bien été choisi
        .InitialFileName = strNomFichier
        If .Show Then
            strchemin = .SelectedItems(1)
            If EnregistrerFichier(strNomFichier, Me.N°, strchemin) Then
                If MsgBox("Voulez-vous ouvrir le fichier ?", vbQuestion + vbYesNo, "Enregistrement d'une pièce jointe") = vbYes Then
                    ShellExecute Me.Hwnd, "open", strchemin, "", CurrentProject.Path, 1
                Else
                    MsgBox "Enregistrement réussi", vbInformation, "Enregistrement d'une pièce jointe"
                End If
            End If
        End If
    End With
End If
End Sub

Function AjouterFichier(strchemin As String, inteleve As Integer) As Boolean
'On Error GoTo err
Dim oRst As DAO.Recordset
    'Ouvre un recordset sur les fichiers de l'éleve passé en paramètre
    Set oRst = CurrentDb.OpenRecordset("SELECT Fichiers FROM tbl_eleve WHERE [N°]=" & inteleve)
  oRst.Edit
        With oRst.Fields(0).Value
        'Ajoute la pièce jointe
        .AddNew
        'Lit le fichier
        .Fields("FileData").LoadFromFile strchemin
        .Update
    End With
    AjouterFichier = True
oRst.Update
 Set oRst = Nothing
End Function

14/02/2018, 21h00
loufab

1 pièce(s) jointe(s)

Il te faut appliquer ceci :

Pièce jointe 351256

Sauf erreur il te faut déclarer des Recordset avec le type Recordset2, sinon le type PJ provoquera une erreur.

Tu as réellement besoin de mettre cette api ? Il existe la bibliothèque FSO qui la remplace. Il y a un tuto sur le sujet.

Tu stockes tous dans un répertoire Temp :

Code:

currentproject.path & "\temp\"

et tu récupère au même endroit.

Tu voudrais pas le code tout fait pas hasard ?

Cordialement,
14/02/2018, 21h32
RaphBdd66

Merci Loufab

J'ai cherché une bibliothèque "FSO" dans l'éditeur VBA / outils / référence mais rien ...

Si tu proposes un code tout fait et si gentiment,
Comment je pourrais refuser :) ????

Merci encore

Tu devras faire quelques modification mineures pour
Prendre en compte plusieurs enregistrements.
L'effacement des fichiers.
et quelques bricoles.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Private Function isVideRst(rst As Recordset2) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : isVideRst
' Author    : Fabrice CONSTANS (MVP)
' Date      : 15/02/2016
' Purpose   : renvoi True si le Rst est Vide, sinon False
' Parameters:
' Return    : Boolean
'---------------------------------------------------------------------------------------
'
10    On Error Resume Next
20       isVideRst = True
30       isVideRst = rst.EOF And rst.BOF
 
End Function
 
Private Sub pImport_TransfererPJ(rstSource As Recordset2, rstDestination As Recordset2)
      '---------------------------------------------------------------------------------------
      ' Procedure : TransfertPiecesJointes
      ' Author    : Fabrice CONSTANS (MVP)
      ' Date      : 06/02/2016
      ' Purpose   : transfert de PJ entre 2 recordsets
      ' Parameters: rstSource est le recordset de la table qui contient les PJ
      '             rstDestination est le recordset de la table qui reçoit les PJ
      '             !!!!! ATTENTION 1 record par recordset
      '---------------------------------------------------------------------------------------
      '
      Dim fldDestination As Field2
      Dim rstPjSource As Recordset2
      Dim rstPjDestination As Recordset2
      Dim strNomFichier As String
      Dim currentId  As Long
 
10    On Error GoTo Errsub
 
      'l'un des Rst est vide on sort
20    If isVideRst(rstSource) Or isVideRst(rstDestination) Then Exit Sub
 
30    rstSource.MoveFirst
40    rstDestination.MoveFirst
 
        'pour chaque Champ
50      For Each fldDestination In rstDestination.Fields
            'si c'est un champ PJ
60          If fldDestination.IsComplex() And Not IsNull(fldDestination) Then
               'traitement PJ avec recordset
70             pCopyPj rstSource.Fields(fldDestination.Name), rstDestination, rstDestination.Fields(fldDestination.Name)
80          End If
90      Next
 
Exitsub:
100   On Error GoTo 0
110   Exit Sub
 
Errsub:
	'ici la gestion d'erreur
 
 
End Sub
 
Private Sub pCopyPj(fldS As Field2, rstDestination As Recordset2, fldD As Field2)
      '---------------------------------------------------------------------------------------
      ' Procedure : pCopyPj
      ' Author    : Fabrice CONSTANS (MVP)
      ' Date      : 20/05/2017
      ' Purpose   : copie la pj
      ' Parameters:
      ' Return    :
      '---------------------------------------------------------------------------------------
      '
            Dim rstPjSource As Recordset2
            Dim rstPjDestination As Recordset2
            Dim strNomFichier As String
 
          'traitement PJ avec recordset
10       On Error GoTo Errsub
 
20        Set rstPjSource = fldS.value
30        Set rstPjDestination = fldD.value
          'traitement de la PJ
          'Pour chaque PJ
40        Do While Not rstPjSource.EOF
              'on fait un Edit dans destination (sinon on ne peut faire un edit du PJ)
50            rstDestination.Edit
              'prépare le chemin de sauvegarde du disque
60            strNomFichier = fHasBackSlash(Environ("temp")) & rstPjSource.Fields("FileName")                        'evite l'erreur le hresult: &h80070003
              'le fichier existe DEJA on le supprime
70            If Len(Dir(strNomFichier)) <> 0 Then fSupprimerFichiers strNomFichier, False
              'on extrait le fichier de la source sur le disque
80            rstPjSource.Fields(0).SaveToFile strNomFichier
              'on ajoute un enreg dans la destination
90            rstPjDestination.AddNew
              'on enregistre le fichier dans la destination
100           rstPjDestination.Fields(0).LoadFromFile strNomFichier
110           rstPjDestination.Update
              'on supprime le fichier du disque
120           If Len(Dir(strNomFichier)) <> 0 Then fSupprimerFichiers strNomFichier, False
              'on sauve l'enregistrement
130           rstDestination.Update
140           rstPjSource.MoveNext
150       Loop
 
Exitsub:
160      On Error GoTo 0
170       rstPjSource.Close
          'rstPjDestination.Close
180       Set rstPjSource = Nothing
190       Set rstPjDestination = Nothing
200      Exit Sub
 
Errsub:
210     If Err.Number = 3820 Then
           'pj existante
220        Resume Next
230     Else
240     'ici la gestion des erreurs  
        Endif
End Sub

Merci de laisser mon nom sur les en-têtes.

Cordialement,

15/02/2018, 20h27
RaphBdd66

Merci pour ton aide !! :)

J'arrive à adapter le code petit à petit.
Juste 2 soucis :

- avec la fonction "fSupprimerFichiers" qui est apparemment manquante.

- Je voudrais enregistrer dans la table de destination mais sur un nouvel enregistrement.
Apparemment, le champ de destination ne doit pas être vide . :(

Dans un premier temps, Est il possible de rajouter la fonction "fSupprimerFichiers" à cette discussion ?

Merci d 'avance
16/02/2018, 09h28
loufab
La fonction manquant est une simple suppression d'un fichier (FAQ).

Oui, les 2 côtés doivent être peuplés puisque c'est une copie. Peuples ton Recordset destination avant de le passer à la fonction.

Le fHasBackSlash() rajoute 1 "\" anti-slash s'il n'existe pas à la fin du chemin. ça c'est facile aussi de la refaire.
Code:

1 2 if right(monchemin,1)<>"\" then ....
16/02/2018, 13h56
RaphBdd66

Merci pour ton aide !!:)

J'ai réussi à me débrouiller pour copier dans un recordset vide.
J'ai aussi trouvé une commande "Kill" pour supprimer un fichier dans mon dossier des pièces jointes temporaire.
19/02/2018, 10h18
loufab

parfait !

Bonne continuation.