Bonjour à tous,

Je rencontre un problème pour modifier un code VBA. ( mes connaissance en VBA sont très limité).

Mon Objectif:
Lorsque j'ajoute une pièce jointe à mon formulaire, je souhaiterai que le nom de cette pièce jointe apparaisse dans un champs texte.

Mon Problème:
J'ai trouver un code qui me permet de lister toutes les pièces jointes contenue dans ma table, je souhaiterai modifier le code en questions pour que seul le nom de ou des pièces jointe présente sur ce formulaire apparaissent.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Option Compare Database
Option Explicit
 
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim RsPJ As DAO.Recordset
Dim Tbldef As DAO.TableDef
Dim fld As DAO.Field
Dim Prp As DAO.Property
Dim Compteur As Long
 
Public Sub CreerChampPJ(NomDeLaTable As String, _
                        NomDuChamp As String, Optional Légende As String = "")
    If Légende = "" Then Légende = NomDuChamp
    Set Db = CurrentDb
    Set Tbldef = Db.TableDefs(NomDeLaTable)
    Set fld = Tbldef.CreateField(NomDuChamp, dbAttachment)
    Tbldef.Fields.Append fld
    Set fld = Tbldef.Fields(NomDuChamp)
    Set Prp = fld.CreateProperty("caption", dbText)
    Prp.Value = Légende
    fld.Properties.Append Prp
    Set Db = Nothing
    Set Tbldef = Nothing
    Set fld = Nothing
    Set Prp = Nothing
End Sub
 
Public Function isPJ(NomDeLaTable As String, NomDuChamp As String) As Boolean
    isPJ = (CurrentDb.TableDefs(NomDeLaTable).Fields(NomDuChamp).Type = dbAttachment)
End Function
 
Function NomsPJ(stringSQL As String, NomDuChamp As String) As String
    Set Db = CurrentDb
    Set Rs = Db.OpenRecordset(stringSQL)
    If Not Rs.EOF Then
        With Rs
            Do Until .EOF
                Set RsPJ = .Fields(NomDuChamp).Value
                With RsPJ
                    Do Until .EOF
                        NomsPJ = NomsPJ & RsPJ.Fields("filename") & ";"
                        .MoveNext
                    Loop
                End With
                Set RsPJ = Nothing
                .MoveNext
            Loop
        End With
    End If
    Set Db = Nothing
    Set Rs = Nothing
End Function
La fonction "NompsPJ"
Permet de lister les noms des pièces jointe, c'est celle ci que je n'arrive pas à modifier.
Je pense que c'est une question de boucle à enlever, mais plus rien ne marche ensuite.

Pour l'utiliser je met dans un champs texte ( nommé Texte2) le code suivant:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
Private Sub Texte2_GotFocus()
If PJ.isPJ("Devis", "PJ") Then
    Me.Texte2 = PJ.NomsPJ("select PJ from Devis ;", "PJ")
Else
    MsgBox "Impossible de lister les pièces jointes dans le champ PJ."
End If
End Sub
PJ étant le champs pièces jointe.
Devis étant la table contenant les pièces jointes.


Merci de votre aide.