Banque d’images : copier les images dans un dossier
Suite à la saga « Banque d’images« , cette question m’a été posée dans les commentaires du blog :
Sur le formulaire d’affichage des images, je mets en place un filtre (par exemple à l’aide du filtre par formulaire). Je souhaiterais ensuite copier toutes les images sélectionnées dans un nouveau dossier de mon ordinateur. Comment que je fais-je ? 😉
Ce qu’il vous faut avant de démarrer
Cet article fait suite à toute une série d’autres billets du blog. Je vous conseille de les consulter ici :
Vous aurez aussi besoin de certaines fonctions de traitement de chaînes et de fichiers déjà détaillées sur le site. Je vous renvoie à ces pages :
Vous aurez besoin des bouts de code VBA traités dans ces différents articles pour que tout fonctionne correctement.
Copier les images
Voici une nouvelle fonction VBA à recopier dans un module standard de votre base de données (pourquoi pas le module modImages
de notre base d’exemple) :
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 |
' --- ' COPIER CERTAINES IMAGES DE LA BASE DANS UN DOSSIER ' --- ' Entrée : strCritere <- Critère SQL permettant de sélectionner les images. ' strDossier <- Dossier de destination. ' Function CopierImagesVersDossier( _ ByVal strCritere As String, _ ByVal strDossier As String) Dim rst As DAO.Recordset Dim strFichierSource As String Dim strFichierCible As String Dim lngTotal As Long ' Vérifier que le dossier existe bien If Dir(strDossier, vbDirectory) = "" Then MsgBox "Dossier [" & strDossier & "] introuvable !", vbExclamation CopierImagesVersDossier = 0 Exit Function End If strDossier = AddBackslash(strDossier) ' Ouvrir la liste des images à copier Dim strSQL As String strSQL = "SELECT * FROM [tblImages]" If strCritere <> "" Then strSQL = strSQL & " WHERE " & strCritere Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset) ' Lecture de toutes les images lngTotal = 0 While Not rst.EOF ' Chemin complet de l'image d'origine et de ' celle de destination strFichierSource = AddBackslash(rst("Dossier")) & rst("Nom Fichier") strFichierCible = FilenameInc(strDossier & rst("Nom Fichier")) ' Si l'image originale existe, on la copie... If Dir(strFichierSource) <> "" Then FileCopy strFichierSource, strFichierCible lngTotal = lngTotal + 1 End If ' Image suivante rst.MoveNext Wend ' On ferme ! rst.Close Set rst = Nothing CopierImagesVersDossier = lngTotal End Function |
Cette fonction reçoit 2 paramètres en entrée :
- Un critère SQL (sans
WHERE
) qui va servir à filtrer les images pour n’en sélectionner qu’une partie. Si ce critère est vide, toutes les images sont copiées. - Le chemin complet du dossier de destination (le dossier où doivent être dupliquées les images). La fonction ne fait rien si le dossier n’existe pas (elle le signale, dans ce cas).
La fonction renvoie comme résultat le nombre d’images copiées (qui peut être 0).
FilenameInc()
dont il a été question sur ce blog pour numéroter les noms de fichiers. De cette façon, on évite que plusieurs images portent le même nom dans le dossier d’arrivée.Le bouton final
Il nous reste à placer un bouton sur le formulaire principal, bouton qui servira à déclencher les opérations.
- Ajoutez un bouton de commande à votre formulaire d’images.
- Nommez-le
btnCopierImages
. - Programmez l’événement
Sur clic
du bouton de cette manière :
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 |
' --- ' COPIE DES IMAGES DANS UN DOSSIER EXISTANT ' --- Private Sub btnCopierImages_Click() ' Décompter les images qui vont être copiées Dim lngImages As Long Dim strCritere As String strCritere = IIf(Me.FilterOn, Me.Filter, "") lngImages = DCount("*", "tblImages", strCritere) ' Confirmation If MsgBox("Vous allez copier " & lngImages & " image(s)." _ & vbCrLf & "Confirmez-vous ?", _ vbQuestion + vbYesNo) = vbNo Then Exit Sub End If ' Sélection du dossier Dim fd As Office.FileDialog Set fd = Application.FileDialog(msoFileDialogFolderPicker) ' Titre de la boîte fd.Title = "Sélectionnez un dossier..." ' Afficher la boîte et traiter le résultat If Not fd.Show() Then Exit Sub End If Dim strDossier As String strDossier = fd.SelectedItems(1) Set fd = Nothing ' Effectuer la copie des images lngImages = CopierImagesVersDossier(strCritere, strDossier) MsgBox "Nombre d'images copiées : " & lngImages, vbInformation End Sub |
Rappel : le code du bouton utilise l’objet FileDialog
, vous devez donc avoir une référence à la bibliothèque Microsoft Office. Au cas où, vérifiez ceci :
- Ouvrez Visual Basic Editor (VBE).
- Cliquez sur le menu Outils / Références.
- Dans la liste, cochez Microsoft Office x.y Object Library (où x.y est le numéro de votre version d’Access, par exemple 11.0 pour Access 2003, 12.0 pour Access 2007, 14.0 pour Access 2010).
Tester !
- Passez en mode Formulaire.
- Appliquez un filtre de formulaire, par exemple. Ou pas… si vous souhaitez copier toutes les images !
- Cliquez sur le bouton, confirmez la copie.
- Sélectionnez un dossier existant (de préférence vide, pour les premiers tests) de votre machine.
RE bonjour,
Concernant ma derniére question, j’ai trouvé, la réponse etant dans vos divers articles, il suffit de lire
Je n’ai aucune connaissance aucune formation je ne parle pas Anglais et grasse à vous et tous les intervenant je reussis à construire quelque chose de correct
encore merci
Je passe à l’étape suivante
Cordialement
Bonjour,
Cette fois ci c’est cette partie du code qui me pose problème: « StringFormat »
‘ Créer un nouveau nom de fichier numéroté,
‘ en vérifiant qu’il n’existe pas déjà
intI = 1
strFileTemp = strFile
While Dir(strFileTemp) <> « »
strFileTemp = StringFormat(« {0}{1}-{2}.{3} », _
FilePath(strFile), _
FilenameWithoutExt(strFile), _
Format(intI, « 00000 »), _
FileExt(strFile))
intI = intI + 1
Wend
Je progresse !?
Merci
Cordialement
Angel > Il doit te manquer au moins la fonction
FilenameInc()
dont il est question dans cet article. Vérifie aussi que tu as bien repris la fonctionAddBackslash()
.Bonjour,
Un petit complement d’info :
FilenameInc()
Lorsque je fait clic droit « répertoire des propriete/methode » je n’est l’ai pas dans la liste
je n’ai que Filename()
Je bute sur cette erreur
Domage organiser mes dossiers image à partir de ma base me semble très interessant
Cordialement
Bonsoir,
Merci de votre attention pour mes petits sousis
voici ou se trouve l’erreur »
‘ Chemin complet de l’image d’origine et de
‘ celle de destination
strFichierSource = AddBackslash(rst(« Dossier »)) & rst(« Nom Fichier »)
strFichierCible = FilenameInc(strDossier & rst(« Nom Fichier »))
Cordialement
Angel > L’erreur se produit sur quel bout de code précisément ?
Bonsoir,
Je suis un amateur sans formation programmation
J’ utilise votre base pour visualiser mes images elle fonctionne bien.
J’ai voulu ajouter la posibilité de copier les photos vers un dossier mais j’ai une erreur de compilation « Sub ou Fonction non definie »
J’ai bien re saisi comme indiqué et j’ai ajouté la réference office necessaire.
Ou ai je fait une erreur
Merci de votre aide
Cordialement
Christian > Telle que la fonction
CopierImagesVersDossier()
est construite, il faut que tous les champs de filtre appartiennent à la table.La raison est sans doute que le filtre est mal constitué, du fait qu’il y a plusieurs champs de même nom. Est-ce qu’il t’est possible de ne prendre dans la source que les champs essentiels ou, sinon, d’attribuer un alias aux champs en double ?
Une autre piste : ne filtrer justement que sur des champs de la table Images, pas sur des champs de tables externes.
… avant de modifier la fonction elle-même bien sûr.
J’ai liée la table tblImages à d’autres tables à l’aide de listes de choix afin de pouvoir affecter à chaque image plusieurs critères (pays, espèces d’animaux, ect…). Le problème est que lorsque j’applique un filtre formulaire sur un des champs concernés et que j’essaye ensuite de copier les images ainsi filtrées dans un dossier, le message suivant apparait : Erreur d’exécution ‘2471’ l’expression entrée comme paramètre de requête est à l’origine de l’erreur suivante : « [Lookup_Country].[Country] » (Country est un nom de champ à la fois dans tblImages et dans la table liée à tblImages)
Christian > Bien vu ! J’ai rectifié la faute.
Meilleurs vœux pour l’année 2012 !
Bonjour Hervé, meilleurs voeux et un grand merci pour le temps accordé.
Il y a une petite erreur d’orthographe dans le code écrit plus haut concernant le bouton btnCopierImages : tu as oublier le r de copier dans Private Sub btnCopieImages_Click()
Sinon tout marche bien, j’ai aussi testé le code pour ouvrir une image avec Windows et ça marche très bien. Encore merci.
Christian > L’article est en ligne, ça se passe par ici…
Christian > J’ai prévu un article la semaine prochaine pour montrer comment faire… sans le plein écran 🙁
Est-ce possible d’ouvrir une photo avec la visionneuse Windows à partir de la base de donnée (en mode plein écran, ce serait encore mieux)?