modification du code vba fichier joint

[Mejri.nacer]

Salut je veux modifier ce code qui nous permet de mettre 1 seul fichier joint je veux que je peux mettre plusieurs fichier joint . Merci
voici le code:

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
Private Sub cmdAllega_Click()
'DECLARATIONS
'------------
    Dim varFilter   As Variant
    Dim strPath     As String
    Dim strFile     As String
    Dim RC          As Integer
    Dim inErrNumber As Integer
    Dim SQL         As String
 
'INITIALIZE
'----------
    On Error GoTo ErrHandler
 
'MAIN BODY
'---------
    '-- Build list of file types to choose from
    GoSub BuildListFileTypes
 
    'Lookup the attachment path
    GoSub GetAttachmentPath
 
    'Open common dialog box for Save with parms built above
    varFileName = ahtCommonFileOpenSave( _
      ahtOFN_HIDEREADONLY, _
      strPath, _
      varFilter, _
      1, _
      "*.*", _
      , _
      "Seleziona un File da Allegare.", _
      hWndAccessApp, _
      True)
 
    'If user cancelled, then exit now
    If IsNull(varFileName) Then
        Exit Sub
    Else
 
        Dim intI As Integer
        Dim stFileName As String
        Dim stFolderPath As String
        Dim sPathRete   As String
        Dim stCodCont As String
        Dim inLen As Integer, inI As Integer
 
        stCodCont = "RDA" & Format(IDRDA.Value, "000000")
        sPathRete = DLookup("[Value]", "tblParameters", "[Parameter]='DiscoRete'")
        'LAN
        stFolderPath = sPathRete & "RDA\Allegati\" & Format(stCodCont, "000000")
        'Locale
        'stFolderPath = PathDB() & "Allegati\Fatture\" & Format(stCodCont, "000000")
 
        If Dir(stFolderPath, vbDirectory) = vbNullString Then
            MkDir stFolderPath
        End If
 
        stFileName = varFileName
 
        'LAN
        stFolderPath = sPathRete & "RDA\Allegati\" & Format(stCodCont, "000000")
        'Locale
        'stFolderPath = PathDB() & "Allegati\Fatture\" & stCodCont
 
        inLen = Len(stFileName)
        inI = Len(stFileName)
        Do While Mid$(stFileName, inI, 1) <> "\"
            inI = inI - 1
        Loop
 
        stFileName = Right$(stFileName, inLen - inI)
        FileCopy varFileName, stFolderPath & "\" & stFileName
 
        Me!txtFileName = stFileName & "#" & stFolderPath & "\" & stFileName & "#"
    End If
 
'WRAP-UP
'-------
WrapUp:
Exit Sub
 
 
'ERROR HANDLER
'-------------
ErrHandler:
 
    MsgBox Err.Description
    Resume WrapUp
 
'CODE SNIPPETS
'-----------------------------------------------------------------------------------------------
BuildListFileTypes:
'-----------------------------------------------------------------------------------------------
'-- This code sets up all of the common dialog file types to pick from.
    'Word
    'varFilter = ahtAddFilterItem(CStr(varFilter), "Word Documents (*.doc)", "*.doc")
    'Excel
    varFilter = ahtAddFilterItem(CStr(varFilter), "Scegli Documento (*.*)", "*.*")
Return
 
'-----------------------------------------------------------------------------------------------
GetAttachmentPath:
'-----------------------------------------------------------------------------------------------
'-- This code looks up the data path for the current project databbase.  If the attachment path
'   does not already exist it will create it.
 
    strPath = "C:\"
 
Return
End Sub