Discussion :

[CrasherSEP]

Bonjour,

J'ai ce code qui m'exporte les pièces jointes d'une table vers différents dossiers et cela fonctionne très bien :-)

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
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
119
120
121
122
123
124
125
126
127
Option Compare Database
 
Private Sub Commande0_Click()
Dim nomtable As String
    Dim dossier As String
 
    nomtable = "R_Extract"
    dossier = CurrentProject.Path
 
    If extractPiecesJointes(nomtable, dossier) Then
        MsgBox "Extraction réussie !", vbExclamation
    End If
 
End Sub
 
 
Public Function extractPiecesJointes(nomtable, cheminDossier) As Boolean
On Error GoTo ERREURGOTO
 
'Me.Texte8.Value = 0
    Dim rst As DAO.Recordset
    ' Dim fso As New Scripting.FileSystemObject
    Dim fso As Object
    Dim folder As String, NomFichier1 As String, NomFichier As String, extension As String
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Set rst = CurrentDb.OpenRecordset(nomtable)
 
    Do Until rst.EOF
 
 
    folder = cheminDossier & "\" & "EXTRACT"
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & rst!NOM
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & "RAPPORT DEVIS"
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
       folder = folder & "\" & rst![Clé]
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 If IsNull(rst![date demande]) Then
 folder = folder & "\" & "SANS DATE"
 Else
 folder = folder & "\" & Format(rst![date demande], "dd/mm/yyyy")
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 
 If IsNull(rst![TYPE_DEMANDES]) Then
 folder = folder & "\" & "SANS TYPE"
 Else
 folder = folder & "\" & rst![TYPE_DEMANDES]
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 
 
 
 
 
 
 
        With rst.Fields("OLE").Value
        'Parcours les PJ
            While Not .EOF
                NomFichier1 = .Fields("FileName")
                extension = Mid(NomFichier1, InStr(NomFichier1, ".") + 1)
                'NomFichier = rst![TYPE_DEMANDES] & " - " & Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                ''NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " (" & rst!Clé & ")." & extension
                If Not fso.FileExists(folder & "\" & NomFichier) Then
                    .Fields("FileData").SaveToFile folder
                    fso.GetFile(folder & "\" & NomFichier1).Name = NomFichier
                End If
                'On passe au suivant
                'Me.Texte8.Value = Clé
                .MoveNext
            Wend
        End With
 
        rst.MoveNext
    Loop
 
    extractPiecesJointes = True
 
    rst.Close
    Set rst = Nothing
 
    GoTo Finishing
 
ERREURGOTO:
    MsgBox (folder)
    'Resume Macro_RechercheEnregistrement_Exit
 
Finishing:
 
End Function

Ce que j'aimerais maintenant, c'est de pouvoir importer l'URL des fichiers exportés dans une table [URL-1].

1. Vérifier si la table [URL-1] existe, si oui, la vider, si non, la créer
2. Créer plusieurs champs : [CHAMPS1] = ID de la table, [CHAMPS2] = L'URL du fichier exporté, [CHAMPS3] = [Clé] de l'enregistrement, voir plus...
3. Enregistrer dans les différents champs

J'ai essayé avec ceci, mais je n'y arrive pas

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
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Option Compare Database
 
Private Sub Commande0_Click()
Dim nomtable As String
    Dim dossier As String
 
    nomtable = "R_Extract"
    dossier = CurrentProject.Path
 
    If extractPiecesJointes(nomtable, dossier) Then
        MsgBox "Extraction réussie !", vbExclamation
    End If
 
End Sub
 
 
Public Function extractPiecesJointes(nomtable, cheminDossier) As Boolean
On Error GoTo ERREURGOTO
 
Set dbs = CurrentDb() ' référence à la base de données courante
If Not TableExiste("URL-1") Then ' si la table destinée à enregistrer les emplacements des fichiers n'existe pas
        ' création de la table permettant d'enregistrer les adresses des fichiers extraits sur le disque
        dbs.Execute "create table [" & "URL-1" & "]([IdPieceJointe] COUNTER, [" & URL & "] TEXT, [" & nomChampID & "] INTEGER);", dbFailOnError
Else ' sinon
        'dbs.Execute "delete * from [" & URL-01 & "];", dbFailOnError ' on vide la table si elle existe déjà
End If
Set rstPJ2 = dbs.OpenRecordset("URL-1") ' ouverture du recordset basé sur la nouvelle table destinée à enregistrer les chemins des pièces jointes
 
 
'Me.Texte8.Value = 0
    Dim rst As DAO.Recordset
    ' Dim fso As New Scripting.FileSystemObject
    Dim fso As Object
    Dim folder As String, NomFichier1 As String, NomFichier As String, extension As String
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Set rst = CurrentDb.OpenRecordset(nomtable)
 
    Do Until rst.EOF
 
 
    folder = cheminDossier & "\" & "EXTRACT"
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & rst!NOM
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & "RAPPORT DEVIS"
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
       folder = folder & "\" & rst![Clé]
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 If IsNull(rst![date demande]) Then
 folder = folder & "\" & "SANS DATE"
 Else
 folder = folder & "\" & Format(rst![date demande], "dd/mm/yyyy")
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 
 If IsNull(rst![TYPE_DEMANDES]) Then
 folder = folder & "\" & "SANS TYPE"
 Else
 folder = folder & "\" & rst![TYPE_DEMANDES]
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 
 
 
 
 
 
 
        With rst.Fields("OLE").Value
        'Parcours les PJ
            While Not .EOF
                NomFichier1 = .Fields("FileName")
                extension = Mid(NomFichier1, InStr(NomFichier1, ".") + 1)
                'NomFichier = rst![TYPE_DEMANDES] & " - " & Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                ''NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " (" & rst!Clé & ")." & extension
                If Not fso.FileExists(folder & "\" & NomFichier) Then
                    .Fields("FileData").SaveToFile folder
                    fso.GetFile(folder & "\" & NomFichier1).Name = NomFichier
                End If
                'On passe au suivant
                'Me.Texte8.Value = Clé
 
 
                rstPJ2.AddNew ' ajout du chemin complet du fichier à la nouvelle table avec l'identifiant de la table principale
                rstPJ2.Fields(URL) = cheminFichier
                rstPJ2.Fields(nomChampID) = rst.Fields(nomChampID)
 
 
                .rstPJ2.Update
                'rstPJ2.Delete
                .MoveNext
            Wend
        End With
 
        rst.MoveNext
    Loop
 
    extractPiecesJointes = True
 
    rst.Close
    Set rst = Nothing
 
    GoTo Finishing
 
ERREURGOTO:
    MsgBox (folder)
    'Resume Macro_RechercheEnregistrement_Exit
 
Finishing:
 
End Function

Pourriez-vous m'aider ?

Merci d'avance

[CrasherSEP]

Je n'y arrive tjs pas

Je bloque déjà au niveau de la création de la table

Voici le code un peu nettoyé...

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
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Option Compare Database
 
Private Sub Commande0_Click()
Dim nomTable As String
    Dim dossier As String
 
    nomTable = "R_Extract"
    dossier = CurrentProject.Path
 
    If extractPiecesJointes(nomTable, dossier) Then
        MsgBox "Extraction réussie !", vbExclamation
    End If
 
End Sub
 
 
Public Function extractPiecesJointes(nomTable, cheminDossier) As Boolean
On Error GoTo ERREURGOTO
 
'Me.Texte8.Value = 0
    Dim rst As DAO.Recordset
 
' ========================================================
    Dim dbs As DAO.Database ' variable objet pour faire référence à la base de données
    Dim rstPJ2 As DAO.Recordset ' variable pour faire référence à la nouvelle table destinée à enregistrer les emplacements des fichiers
    Dim cheminFichier As String ' chemin complet du fichier sur le disque
' ========================================================
 
    ' Dim fso As New Scripting.FileSystemObject
    Dim fso As Object
    Dim folder As String, NomFichier1 As String, NomFichier As String, extension As String
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Set rst = CurrentDb.OpenRecordset(nomTable)
 
 
 
' =========================================================
    If Not TableExiste(nomTableURL) Then  ' si la table destinée à enregistrer les emplacements des fichiers n'existe pas
    ' création de la table permettant d'enregistrer les adresses des fichiers extraits sur le disque
    dbs.Execute "create table [" & nomTableURL & "]([IdPieceJointe] COUNTER, [" & nomchampChemin & "] TEXT, [" & nomChampID & "] INTEGER, [" & lacle & "] TEXT);", dbFailOnError
    Else ' sinon
    dbs.Execute "delete * from [" & nomTableURL & "];", dbFailOnError ' on vide la table si elle existe déjà
    End If
 
    ' ouverture du recordset basé sur la nouvelle table destinée à enregistrer les chemins des pièces jointes
    Set rstPJ2 = dbs.OpenRecordset(nomTableURL)
' ========================================================
 
 
    Do Until rst.EOF
 
 
    folder = cheminDossier & "\" & "EXTRACT"
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & rst!NOM
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & "RAPPORT DEVIS"
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
       folder = folder & "\" & rst![Clé]
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 If IsNull(rst![date demande]) Then
 folder = folder & "\" & "SANS DATE"
 Else
 folder = folder & "\" & Format(rst![date demande], "dd/mm/yyyy")
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 
 If IsNull(rst![TYPE_DEMANDES]) Then
 folder = folder & "\" & "SANS TYPE"
 Else
 folder = folder & "\" & rst![TYPE_DEMANDES]
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 
 
 
 
 
 
 
        With rst.Fields("OLE").Value
        'Parcours les PJ
            While Not .EOF
                NomFichier1 = .Fields("FileName")
                extension = Mid(NomFichier1, InStr(NomFichier1, ".") + 1)
                'NomFichier = rst![TYPE_DEMANDES] & " - " & Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                ''NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " (" & rst!Clé & ")." & extension
                If Not fso.FileExists(folder & "\" & NomFichier) Then
                    .Fields("FileData").SaveToFile folder
                    fso.GetFile(folder & "\" & NomFichier1).Name = NomFichier
' =======================================================
                    cheminFichier = folder & "\" & NomFichier
' =======================================================
                End If
 
 
' =======================================================
        rstPJ2.AddNew
        rstPJ2.Fields(nomchampChemin) = cheminFichier
        rstPJ2.Fields(nomChampID) = rst.Fields(nomChampID)
        rstPJ2.Fields(lacle) = rst!Clé
        rstPJ2.Update
' =======================================================
 
                'On passe au suivant
                'Me.Texte8.Value = Clé
                .MoveNext
            Wend
        End With
 
        rst.MoveNext
    Loop
 
    extractPiecesJointes = True
 
    rst.Close
 
' ========================================================
    rstPJ2.Close
' ========================================================
 
    Set rst = Nothing
 
' ========================================================
    Set rstPJ2 = Nothing
    Set dbs = Nothing
' ========================================================
 
    GoTo Finishing
 
ERREURGOTO:
    MsgBox (folder)
    'Resume Macro_RechercheEnregistrement_Exit
 
Finishing:
 
End Function
 
Public Function TableExiste(ByVal nomTableURL As String) As Boolean
    On Error Resume Next
    TableExiste = (CurrentDb.TableDefs(nomTableURL).Name = nomTableURL)
End Function

[CrasherSEP]

Bonjour à toutes et tous

Le but de ce message, n'est pas de faire remonter le sujet, mais j'ai vraiment besoin que ce code fonctionne

Personne pour m'aider à régler le problème de l'importation des url's pendant l'importation des pièces jointes ?

En résumé : entrer le lien complet des fichiers exportés dans une table.

Belle journée à vous

[deedolith]

Salut,

Pourquoi créer la table par code ?
Ce sera autrement plus simple de la créer dans ta BDD une fois pour toute, le code se contente de manipuler les données.
D'autant plus, qu'une fois créée, la table ne sera jamais supprimée.

[CrasherSEP]

Bonjour,

Oui, une table fixe m'irait très bien aussi Partons alors d'une table nommé URL01 avec comme champs : [Clé], [URL], [date demande], [TYPE_DEMANDES], [NOM], [NomFichier], [extension]
Comment faire pour que cette table soit incrémentée des URL's des pièces jointes exportées ?

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
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
Option Compare Database
 
Private Sub Commande0_Click()
Dim nomtable As String
    Dim dossier As String
 
    nomtable = "R_Extract"
    dossier = CurrentProject.Path
 
    If extractPiecesJointes(nomtable, dossier) Then
        MsgBox "Extraction réussie !", vbExclamation
    End If
 
End Sub
 
 
Public Function extractPiecesJointes(nomtable, cheminDossier) As Boolean
On Error GoTo ERREURGOTO
 
'Me.Texte8.Value = 0
    Dim rst As DAO.Recordset
    ' Dim fso As New Scripting.FileSystemObject
    Dim fso As Object
    Dim folder As String, NomFichier1 As String, NomFichier As String, extension As String
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Set rst = CurrentDb.OpenRecordset(nomtable)
 
    Do Until rst.EOF
 
 
    folder = cheminDossier & "\" & "EXTRACT"
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & rst!NOM
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & "RAPPORT DEVIS"
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
       folder = folder & "\" & rst![Clé]
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
 If IsNull(rst![date demande]) Then
 folder = folder & "\" & "SANS DATE"
 Else
 folder = folder & "\" & Format(rst![date demande], "dd/mm/yyyy")
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
  If IsNull(rst![TYPE_DEMANDES]) Then
 folder = folder & "\" & "SANS TYPE"
 Else
 folder = folder & "\" & rst![TYPE_DEMANDES]
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
         With rst.Fields("OLE").Value
        'Parcours les PJ
            While Not .EOF
                NomFichier1 = .Fields("FileName")
                extension = Mid(NomFichier1, InStr(NomFichier1, ".") + 1)
                'NomFichier = rst![TYPE_DEMANDES] & " - " & Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                ''NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " (" & rst!Clé & ")." & extension
                If Not fso.FileExists(folder & "\" & NomFichier) Then
                    .Fields("FileData").SaveToFile folder
                    fso.GetFile(folder & "\" & NomFichier1).Name = NomFichier
                End If
                'On passe au suivant
                'Me.Texte8.Value = Clé
                .MoveNext
            Wend
        End With
 
        rst.MoveNext
    Loop
 
    extractPiecesJointes = True
 
    rst.Close
    Set rst = Nothing
 
    GoTo Finishing
 
ERREURGOTO:
    MsgBox (folder)
    'Resume Macro_RechercheEnregistrement_Exit
 
Finishing:
 
End Function

[loufab]

Bonjour,

Je ne vois pas de composition d'URL dans ton code.

Cordialement,

[CrasherSEP]

Bonjour,

Non... il était justement là le problème ;-)

Mais j'ai trouvé comme un grand

Bonne journée

[loufab]

N'hésite pas à partager ta trouvaille, peut-être que des devnautes sont intéressés par ton approche.

[CrasherSEP]

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
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
119
120
121
122
123
124
125
126
127
Option Compare Database
 
Private Sub Commande0_Click()
Dim nomTable As String
    Dim dossier As String
 
    nomTable = "R_Extract"
    dossier = CurrentProject.Path
 
    If extractPiecesJointes(nomTable, dossier) Then
        MsgBox "Extraction réussie !", vbExclamation
    End If
 
End Sub
 
 
Public Function extractPiecesJointes(nomTable, cheminDossier) As Boolean
 
' --------- OK ----------
 
On Error GoTo ERREURGOTO
 
'Me.Texte8.Value = 0
    Dim rst As DAO.Recordset
Dim rs As Recordset
    ' Dim fso As New Scripting.FileSystemObject
    Dim fso As Object
    Dim folder As String, NomFichier1 As String, NomFichier As String, extension As String
    Dim p1 As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Set rst = CurrentDb.OpenRecordset(nomTable)
Set rs = CurrentDb.OpenRecordset("URL01", DB_OPEN_DYNASET)
 
    Do Until rst.EOF
 
 
    folder = cheminDossier & "\" & "EXTRACT_PJ - REUNION_DOCUMENT"
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & rst!NOM
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
        folder = folder & "\" & "REUNION_DOCUMENT"
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 If IsNull(rst![Date T]) Then
 folder = folder & "\" & "SANS DATE"
 Else
 folder = folder & "\" & Format(rst![Date T], "dd/mm/yyyy")
 End If
 
        If Not fso.FolderExists(folder) Then
            fso.CreateFolder (folder)
        End If
 
 
 
        With rst.Fields("document").Value
        'Parcours les PJ
            While Not .EOF
                NomFichier1 = .Fields("FileName")
 
                'extension = Mid(NomFichier1, InStr(NomFichier1, ".") + 1)
                p1 = InStrRev(NomFichier1, "."): extension = Right(NomFichier1, (Len(NomFichier1) - p1) - 0)
 
                'NomFichier = rst![TYPE_DEMANDES] & " - " & Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
                ''NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " - " & rst!NOM & "." & extension
               'NomFichier = Left(NomFichier1, InStr(NomFichier1, ".") - 1) & " (" & rst!Clé & ")." & extension
                NomFichier = Left(NomFichier1, p1 - 1) & " (" & rst![Clé Affilié] & ")." & extension
 
                If Not fso.FileExists(folder & "\" & NomFichier) Then
                    .Fields("FileData").SaveToFile folder
                    fso.GetFile(folder & "\" & NomFichier1).Name = NomFichier
                End If
                'On passe au suivant
                'Me.Texte8.Value = Clé
 
 
 
 
rs.AddNew
 
rs!CLE_AFFILIE = rst![Clé Affilié]
rs!NOM = rst![Nom Affilié]
rs!PRENOM = rst![Prénom Affilié]
rs![DATE_T] = Format(rst![Date T], "dd/mm/yyyy")
rs!URL = folder & "\" & NomFichier
rs!NOM_FICHIER = Left(NomFichier1, p1 - 1) & " (" & rst![Clé Affilié] & ")"
rs!EXTENSION_DOC = UCase(extension)
 
rs.Update
 
 
 
                .MoveNext
            Wend
        End With
 
        rst.MoveNext
    Loop
 
    extractPiecesJointes = True
 
    rst.Close
    Set rst = Nothing
 
    GoTo Finishing
 
ERREURGOTO:
    MsgBox (folder)
    'Resume Macro_RechercheEnregistrement_Exit
 
Finishing:
 
End Function

[loufab]

C'est pour cela que je ne l'avais pas vu la création d'url.

Ce n'est pas des URL que tu manipules mais des chemins (path).

URL c'est l'acronyme de "Uniform Resource Locator" qui est réservé à l'environnement Internet.