VBA création de dossiers dans windows

Bonjour à tous.

J'ai trouvé ce code sur le net et je cherche à l'adapter.

Je m'explique, j'ai un tableau avec des lignes comportant toutes les informations d'un chantier, avec des liens hypertexte vers des fichiers (demande, pv de conformité, plan, photo etc)

Je travail donc avec cette base de donnée, c'est très efficient notamment pour le retour d’expérience.

Dans mon entreprise une autre vision est de classer tout ça dans des dossiers. 2 écoles s'affrontent et je me demande si je ne pouvais pas créer des dossiers issus de mon tableau.

Le code ci dessous permet de copier un fichier dans un dossier destination, si le dossier n'existe pas, il le crée dans un premier temps puis copie le fichier dans le dossier.

Le nom de dossier est établi dans la macro.

L'idée est d'aller chercher le nom du fichier à créer dans une des cases de mon tableau (nom du chantier) et de copier les différents fichiers si ils existent dans la même ligne de mon tableau.

Public Sub AjoutFich()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DD As String 'déclare la variable DD (Dossier de Destination)
Dim I As Byte 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim F As String 'déclare la variable F (Fichier)
Dim NF As String 'décalre la variable NF (Nom du Fichier)
Dim SF As Object 'déclare la variable SF (Système de Fichier)

ActiveCell.Select 'enlève le focus au bouton
Set O = ActiveSheet 'définit l'onglet O
DD = ThisWorkbook.Path & "\note de calculs\" 'définit le dossier de destination DD
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir DD 'définit le dossier courant (génère une erreur si ce dossier n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été généré
    Err.Clear 'supprime l'erreur
    MkDir DD 'créé le sous-dossier "note de calculs"
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
With Application.FileDialog(msoFileDialogFilePicker) 'prend en compte la boîte de dialogue [Parcourir]
    .AllowMultiSelect = True 'premet la sélection multiple
    If .Show = -1 Then 'condition : si la boîte est affichée
        For I = 1 To .SelectedItems.Count 'boucle sur tous les fichiers sélectionnés
            'définit la cellule de destination DEST (e32)
            Set DEST = IIf(O.Range("e32").Value = "", O.Range("e32"), O.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
            F = Dir(.SelectedItems(I)) 'définit le fichier F
            Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
            SF.CopyFile .SelectedItems(I), DD & NF 'copie le fichier sélectionné dans le dossier de destination DD avec NF comme nom
            ActiveSheet.Hyperlinks.Add Anchor:=DEST, Address:=DD & NF, TextToDisplay:=NF 'crée le lien hypertexte
    Next I 'prochain fichier de la boucle
    End If 'fin de la condition
End With 'fin de la prise en compte de la boîte de dialogue [Ouvrir]
End Sub

Je vais mettre un lien mais peux etre que vous avez déjà des idées.

Merci pour votre aide

a plus tard

Bonjour,

Je vais mettre un lien...

ou est le lien ?

Voila le lien.

Les noms des dossiers principaux seraient pris dans la collone B

Les sous dossiers seraient issus d'un concatainer des collones C et G

Ils contiendraient les fichiers des collones V à Z, quand il y a quelque chose dedans.

J ai mis la macro dedans, c'est une macro que j'ai trouvé sur ce forum.

Ce tableau à la base me permet via plusieurs onglets et macros, d'imprimer des Pv et differentes pancartes signalétiques, toutes les infos d'un chantier son contenues dans une ligne du tableau. Je voudrai in fine pouvoir archiver en meme temps dans des dossiers ses pv et pancartes plus les documents annexes des collones V à Z.

J'ai regarder hier soir sur le forum, j'ais quelques pistes mais ca reste encore comliquer pour moi,

Merci pour votre aide

Bonjour

ci joint un essai

n'ayant pas les fichiers dans les liens hypertext... difficile de faire un essai complet

Fred

Super merci fred,

Je viens de lancer la macro.

Il se passe bien quelque chose mais je vais mettre les mains dans le cambouis avant de te demander une modif.

tous les dossiers sont créés mais les uns dans les autres en cascade, je vais tenter de faire fonctionner la macro seulement sur une ligne présélectionnée.

Et parcontre je ne comprend pas comment definir la destination.

Je cherche et je reviendrais vers vous.

Bonjour effectivement... petite coquille ...inversion d'ordre de ligne

remplacer

DD = ThisWorkbook.Path & "\"
For lg = 2 To O.Range("A" & Rows.Count).End(xlUp).Row

par ceci

For lg = 2 To O.Range("A" & Rows.Count).End(xlUp).Row
DD = ThisWorkbook.Path & "\"

et ThisWorkbook.Path définit l'emplacement du dossier de départ... en l’occurrence ici le dossier où se trouve ce fichier avec cette macro...

fred

il y a quelques petites choses étranges que je n'arrive pas à comprendre

cela crée un double du dossier dans lequel se trouve de workbook. Et je n'arrive pas a effacer les dossiers par la suite.

Autre chose, si les fichiers des colonnes v a z sont rajouter par la suite, si on relance la macro, ca ne les copie pas. Peut etre faut il changer l'ordre de cette façon ?

'copy des fichiers vers l'endroit de destination
For col = 22 To 26 'colonne V à Z
    'si il y a un lien dans la cellule en cours de traitement
    If (oFSO.FileExists(Source)) Then oFSO.CopyFile Source, (rep & DD & fichier), True
    If O.Cells(lg, col).Hyperlinks.Count > 0 Then
    Source = O.Cells(lg, col).Hyperlinks(1).Address
    fichier = Mid(Source, InStrRev(Source, "\", -1) + 1)
      End If
    Next col
Next lg
End Sub

j'ai pensé pour la sélection remplacer Dim lg As integer par Dim lg As Areas,

Peux etre O par row.select pour ne travailler que linge par ligne.

Ensuite j'enlèverais la commande ligne suivante.

bonjour

Autre chose, si les fichiers des colonnes v a z sont rajouter par la suite, si on relance la macro, ca ne les copie pas. Peut etre faut il changer l'ordre de cette façon ?

normalement si... le fichier de destination est ecraser par le nouveau qui arrive c'est fait avec le parametre true de cette instruction :

oFSO.CopyFile Source, (rep & DD & fichier), True

si tu veux travailler ligne par ligne pour faire des essais...

tu met en commentaire cette ligne :

For lg = 2 To O.Range("A" & Rows.Count).End(xlUp).Row

et juste en dessous tu met

lg = N° de ligne que tu veux...

ne pas oublié de mettre aussi celle ci en commentaire

Next lg

Fred

je regarde ca.

Au sujet du fichier non supprimable ? si je veux supprimer le dossier comprenant le tout, ca m'affiche une erreur inattendu. "le répertoire n'est pas vide"

Suppression manuelle ??

Sur quel système d'exploitation?

Fred

Je suis sur w10

J'ai vérifier, ca ne prend pas en compte les pièces jointes ajoutées.

Cela a fonctionnée la première fois lorsque les fichier été en cascades.

Je n'ose pas le mettre dans un autre fichier pour tester une première foi la macro avec PJ puisque je n'arrive pas à le supprimer pour le. moment

Bizarre

le fichier ne serait pas ouvert ???

perso je ne connais pas W10... mais j'ai jamais rencontré le problème avec un W7 pro..... tu ne serais pas dans un dossier de type drive ??? dropbox, google drive,.....

car j'ai une connaissance dans ces dossiers drive, il ne peut pas renommer ou supprimer des fichiers/dossier une fois de temps en temps ... et passer 1/2 journée ou plus il peut... c'est complètement aléatoire et pas de solution trouvé pour le moment....

par contre ceci

J'ai vérifier, ca ne prend pas en compte les pièces jointes ajoutées.

ce n'est pas logique.... il y a bien des liens hypertexte dans tes nouvelles cellules ???

Fred

J'ai fais des prises d'écran des dossiers créés.

cela crée en plus un dossier qui ressemble à un raccourci du dossier principal le "workbook.path" donc. (après enregistrement.jpg )

J'ai pris soin de le mettre dans une clefs USB pour la formater (ca fonctionne)

Une foi que j'entre sur le "raccourci" et que je reviens en arrière il perd son nom. C'est très étrange. (après enregistrement 2.jpg)

Et quand je veux les supprimer, certain s'effaces et d'autres me font une erreur, soit inconnue soit que le fichier n'existe pas. Mais il est bel et bien là. (après enregistrement 3.jpg)

Comment puis je changer le dossier de destination de "sur place" avec workbook.path vers une autre destination qui serait toujours la même voir en réseau.... serait ce possible ?

Merci pour cet aide, même si j'ai l'impression de ramer, mes connaissances s'approfondissent quand même.

Parcontre oui les liens ca marche très bien en fait, je comprends pas pourquoi ca ne marchait pas, j'ai du faire une fausse manip avec le code. Je suis repartis à zéro et c'est ok.

Serait il possible de modifier un peux le code pour lancer la macro après avoir sélectionner une ligne complète. ca lancerait la création des dossiers et fichier seulement de la ligne sélectionné.

Cela peux être intéressant lorsque le tableau se complète petit à petit.

Avec ton code, je commence a comprendre le fonctionnement des boucles, mais je n'arrive pas à la faire démarer sur une Row.

Pour traiter une seule ligne et changer le dossier de départ garde mon fichier de départ et regarde ma réponse de 15h30... j'avais donné tous ces renseignements...

Par contre il faut que DD soit après le for... comme aussi expliquer plus tôt

Fred

Je regarderais demain pour ne faire que la ligne ou une cellile est sélectionnée

Fred

oui Fred, je suis dessus j'avance pas rapidement, mais je l'ai intégré sur mon vrai fichier.

La création des dossiers fonctionne mais pour le moment je n'arrive plus a enregistrer les PV....

quoi qu'il en soit le code complet avec la boucle pourra me servir plus tard.....

Je suis un gros débutant en VBA, jusqu'à présent je n'utilisais que l'enregistreur de macro, mais là c'est un autre niveau.

bonjour

maintenant le code traite seulement la ligne ou une cellule est sélectionnée, ATTENTION je 'ai pas géré la sélection de plusieurs cellules..

donc on se place dans une des cellules de la ligne que tu veux faire et lancement du code...

fred

Salut Fred

Merci pour ton aide.

Je viens de comprendre un problème. Arrête moi si je me trompe.

Le code permet d'aller chercher les PJ en copiant le lien hyper texte dans les cellules. Les cellule hypertexte comprennent le chemin complet de l'emplacement des PJ, donc le code peut retrouver les fichier pour aller les copier dans les dossier.

Mon problème est que je n'ai pas le chemin complet dans mes cellules.

En fait mon tableau à la base me permet d'imprimer des proces verbaux de conformité des travaux. Les infos contenues dans les cellules sont reportées sur ces PV. Les PJ sont ajoutées dans la manip mais je fais d'une pière deux coups, CAD que la reférences du lien hyper text est réduite à sa dénomination, et non pas son chemin complet.

Donc dans mon PV je retrouve une référence et non pas un chemin informatique, mais dans mon tableau, je peux avoir accès aux PJ.

j'utilise ces macros pour insérer les liens et les renommer.

Sub Lien_NDC()
fichier = Application.GetOpenFilename
If fichier = 0 Then Exit Sub
nom = Application.InputBox("Entrez le nom qui sera affiché dans le PV", "DONNER UN NOM AU LIEN")
If nom = "" Or nom = 0 Then
MsgBox "Vous devez saisir un nom pour le lien", vbCritical + vbOKOnly
Exit Sub
End If
Cells(32, 5).Formula = "=HYPERLINK(""" & fichier & """,""" & nom & """)"
End Sub

J'ai fait le test, ca fonctionne très bien lorsque il y a le chemin mais ca ne fonctionne pas avec la référence seule.

Je pourrais toujours décomposer l'action, mais je travail depuis des mois sur cette macro et si je pouvais la combiner directement avec la tienne ca serait génial.

Je continue sur le chemin VBA.