Discussion :

[Thumb down]

Bonjour,
Les querelles "d'experts" n'ont à mon sens rien à faire dans ce fil ; il perturbe la compréhension du demandeur qui n'a peut être pas le niveau requis pour en apprécier les tenants et aboutissants.

Prendre l'habitude de refermer les objets qu'on a ouvert ne nuis pas à l'application .Ne pas refermé un objet alors qu'il le faudrait nuis à l'application.

Ceci dit rien ne vous empêche d'ouvrir un sujet pour en débattre.

[CrasherSEP]

Hey les amis... J'ai juste demandé de l'aide pour extraire facilement les pièces jointes d'une table avec rangement automatique dans différents répertoires afin d'éviter les erreurs de fichiers avec le même nom et pour les identifier plus facilement etc...

Soyons zen

[CrasherSEP]

Grand silence...

[deedolith]

Créer des répertoires et renommer les noms évitera les problèmes des fichiers portants les mêmes noms dans les différents enregistrements ainsi qu'un rangement automatique...

Salut,

Concernant la création de répertoire, je te renvoie vers ma réponse précédente (#12).
Concernant le renommage éventuel de fichier, oui mais sous quels critères ? Quel nom doit-on attribuer à un fichier si un nom identique existe déja ?
Concernant le rangement automatique, peux-tu élaborer ?

[CrasherSEP]

Bonjour,

Mon fichier [fichierjp.accdb] :

Une table : table01
champ1 - pièce jointe : champpj
champ2 : nomj
champ3 : id
champ4 : userj

Le code fonctionne très bien, mais j'aimerais par enregistrement/ligne :

1. créer un répertoire [champ4] si il n'existe pas
2. dans ce répertoire, créer un répertoire [champ2] si il n'existe pas
3. enregistrer dans ce répertoire les pièces jointes et les renommant : [champ 3] & " - " & nom du fichier
4. faire cela pour toutes les lignes...

Concernant la création de répertoire, je te renvoie vers ma réponse précédente (#12).
* J'ai vu, mais comment insérer ce code dans les boucles... ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub CreateFolder(ByVal Path As String)
    Dim Fso As Object       '// Scripting.FileSystemObject
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    If Not (Fso.FolderExists(Path)) Then
        Fso.CreateFolder Path
    End If
End Sub

Concernant le renommage éventuel de fichier, oui mais sous quels critères ? Quel nom doit-on attribuer à un fichier si un nom identique existe déjà ?
* Enregistrer dans ce répertoire les pièces jointes et les renommant : [champ 3] & " - " & nom du fichier (Le [champ3] étant unique, plus de problème de nom identique

Concernant le rangement automatique, peux-tu élaborer ?
*Créer un répertoire [champ4] si il n'existe pas
*Dans ce répertoire, créer un répertoire [champ2] si il n'existe pas

[loufab]

Visiblement tu sais ce qu'il faut faire.

Qu'attends-tu du forum dans ce cas ?

[CrasherSEP]

Bonjour,

J'aimerais un exemple de code avec les boucles et un exemple pour renommer les documents... Je n'y arrive pas...

Bonne journée

[deedolith]

Sans vouloir t'offenser,
mais appeler une fonction dans une boucle, c'est la base de chez La Base:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Sub Test()
    Dim i As Long
    For i = 1 To 10
        MaSousFonction ThisWorkbook.Name, i
    Next
End Sub
 
Private Sub MaSousFonction (ByVal Name As String, ByVal Count As Long)
    Debug.Print "Affichage de " & Name & " (" & Count & " fois)"
End Sub

[CrasherSEP]

Whoooo, mais il m'en faut plus...

Je sais faire une boucle, je sais appeler une fonction, le truc est que je n'arrive pas à créer les fonctions etc... qui :

• Ferait une boucle sur tous les enregistrements d'une table [table01]
• - Qui vérifierait si le répertoire [champ4] existe, si non il créerait le répertoire,
• - Qui vérifierait si le répertoire [champ4]/[champ2] existe, si non il créerait le répertoire,
• - Enregistrerait tous les documents [champ1] dans le répertoire [champ4]/[champ2] en modifiants le nom du fichier en [champ3] & " - " & nom du fichier

[deedolith]

Heu ...

Je te renvoie vers ma première réponse où je t'ai présenté comment boucler sur les enregistrements d'une table et les pièces jointes (2 boucles imbriquées):
https://www.developpez.net/forums/d2.../#post12010306

Tu n'as plus qu'a écrire les requêtes qui vont bien,
et donner les arguments adéquat (les champs des recordsets) aux fonctions en charge de:
- Vérifier l'existence de dossier.
- Créer un dossier
- Vérifier l'existence de fichier
- Supprimer un fichier.
- Enregistrer la pièce jointe.

La seule difficulté éventuelle peut être la création de dossiers de façon récursive.

[Crachover]

Me revoilà...

Voici mon code qui...

Quand je lance, il créé bien le dossier du 1er niveau ainsi que celui du 2ème niveau et il y enregistre les fichiers, le PROBLEME est après... il continu à enregistrer les documents des autres lignes dans le même dossier et là, il devrait de nouveau vérifier les deux niveaux de dossier...

Pouvez-vous m'aider ? Merciiiii

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
Option Compare Database
 
Private Sub Commande0_Click()
Dim chemin As String
Dim Db As DAO.Database
Set Db = CurrentDb
 
chemin = "C:\Users\Propriétaire\Desktop\ACCESS TEST PIECES JOINTES EXPORTATION\EXPORTATIONS\"
 
 
Dim Rs As DAO.Recordset
Set Rs = Db.OpenRecordset("SELECT [CHAMPPJ] FROM table01;")
Set Rs2 = Db.OpenRecordset("SELECT [NOMJ] FROM table01;")
Set Rs3 = Db.OpenRecordset("SELECT [USERJ] FROM table01;")
While Not Rs.EOF
    Dim RsAttachment As DAO.Recordset2    '// Attention au type de recordset: Recordset2 et pas Recordset
    Set RsAttachment = Rs("CHAMPPJ").Value
 
    While Not RsAttachment.EOF
 
 
 
' Création du dossier du 1er niveau
    Dim Fso As Object       '// Scripting.FileSystemObject
    Dim chemin2 As String
    Set Fso = CreateObject("Scripting.FileSystemObject")
    chemin2 = chemin & Rs2("NOMJ").Value
    Path = chemin2
    If Not (Fso.FolderExists(Path)) Then
        Fso.CreateFolder Path
    End If
 
 
 
' Création du dossier du 2ème niveau
    Dim Fso2 As Object       '// Scripting.FileSystemObject
    Dim chemin3 As String
    Set Fso2 = CreateObject("Scripting.FileSystemObject")
    chemin3 = chemin2 & "\" & Rs3("USERJ").Value
    Path = chemin3
    If Not (Fso2.FolderExists(Path)) Then
        Fso2.CreateFolder Path
    End If
 
 
 
' Création du nom du fichier
  ' nom du fichier PLUS HEURE DU MOMENT
  ' Exemple : image01 (10:21:25).jpg
 
 
 
' Enregistrement du fichier
        RsAttachment("FileData").SaveToFile chemin3
        RsAttachment.MoveNext
    Wend
    Rs.MoveNext
Wend
End Sub

[Crachover]

Salut,

Personne pour m'aider ?

Bon week-end

[Robert1957]

Bonjour Crachover,

je ne crois pas que vous ayez bien saisi les explications et codes proposés. Ce que vous montrez au post #31 ne reflète pas les propositions des posts précédent.

Voici un code complet qui fait exactement ce que vous demandez dans le post #11 basé sur les explications des différents posts.

Dans un module standard collé le code suivant:

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
Option Compare Database
Option Explicit
 
'Répertoire de départ qui doit exister sur votre ordi
Public Const conRepertoire = "C:\Users\Propriétaire\Desktop\ACCESS TEST PIECES JOINTES EXPORTATION\EXPORTATIONS\"
 
Function EnregistrerFichier() As Boolean
On Error GoTo gestion_err
'Déclaration des variables
Dim db                      As DAO.Database: Set db = CurrentDb
Dim rst                     As DAO.Recordset
Dim rstA                    As DAO.Recordset2
Dim sRepertoire             As String
'Parcours de la table
    Set rst = db.OpenRecordset("SELECT table01.* FROM table01;")
    Do While Not rst.EOF
'Ouverture du record des pièces jointes
        Set rstA = rst("champpj").Value
'Vérification que le record existe et qu'il contient des pièces jointes
        If Not rstA.EOF Then
            sRepertoire = conRepertoire & rst("userj")
'Création du premier niveau de répertoire
            CreerDossier sRepertoire
            sRepertoire = sRepertoire & "\" & rst("nomj")
'Création du deuxième niveau de répertoire
            CreerDossier sRepertoire
            sRepertoire = sRepertoire & "\"
'Extraction des pièces jointes et enregistrement en modifiant le nom de la pièce
            Do While Not rstA.EOF
                rstA("FileData").SaveToFile sRepertoire & rst("userj") & "-" & rstA("FileName")
                rstA.MoveNext
            Loop
            rstA.Close
            Set rstA = Nothing
        End If
        rst.MoveNext
    Loop
'Retourne vrai si tout se passe bien
    EnregistrerFichier = True
 
Sortie:
On Error Resume Next
    rst.Close
    Set rst = Nothing
    rstA.Close
    Set rstA = Nothing
    Set db = Nothing
    Exit Function
gestion_err:
    Select Case err.Number
    Case 3839:
'        Le fichier existe déjà
        Resume Next
    Case Else
        MsgBox "Erreur dans EnregistrerFichier" & " " & err.Number & " " & err.Description
    End Select
    Resume Sortie
End Function
 
Private Sub CreerDossier(strDossier As String) 'sub pour la création du repertoire
On Error GoTo gestion_err
 
    MkDir strDossier
 
Exit Sub
gestion_err:
    Select Case err.Number
        Case 75 'le dossier existe déjà
        Resume Next
    Case Else
        MsgBox "Erreur dans CreerDossier" & " " & err.Number & " " & err.Description
    End Select
End Sub

Vous pouvez appelez la fonction depuis un bouton de commande dans un formulaire ou autre puisqu'elle est publique. Le retour est vrai ou faux selon le cas.

La sub "CreerDossier" est privé, elle doit donc être dans le même module que la fonction "EnregistrerFichier"

Bonne journée

[deedolith]

Concernant la création des dossiers, on peut passer par une fonction récursive.
Opération très facile avec la librairie FSO:

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
Public Sub CreateDirectory(ByVal Path As String)
    Dim Fso As Scripting.FileSystemObject
    Set Fso = CreateObject("scripting.FileSystemObject")
 
        '// Precondition: Le lecteur (disque) doit exister
    Debug.Assert Fso.DriveExists(Fso.GetDriveName(Path))
 
        '// Si le dossier existe
        '// Ne rien faire
    If Not (Fso.FolderExists(Path)) Then
            '// Si le dossier n'existe pas
            '// Créer le dossier parent
        CreateDirectory Fso.GetParentFolderName(Path)
            '// créer le dossier
        Fso.CreateFolder Path
    End If
End Sub