Copier un fichier vers un dossier VBA
c
Bonjour,
Premier post sur ce forum et par avance je remercie tous les contributeurs car même si je n'étais pas inscrit celui-ci m'a beaucoup aidé dans mes créations
Je n'ai que quelques base du VBA et donc je ne sais pas si ce que je veux faire est possible je m'explique :
J'ai un fichier excel avec une colonne (référence) avec une référence par ligne (ex: DF324G), dans un dossier j'ai un fichier pdf qui correspond la référence dans le fichier excel.
Le but et d'analyser cette colonne et d'aller chercher dans un répertoire le fichier correspondant et de le copier dans un dossier qui portera le nom du classeur.
ex: fichier excel famille avec ligne 1 toto et ligne 2 tata -------- alors dossier famille avec toto.pdf et tata.pdf
Je ne sais pas si je suis clair, je n'ai rien trouvé à ce sujet mais je pense que c'est faisable...
Je ne cherche pas forcément quelque chose de tout fait (quoique ce serait pas mal
Merci pour vos réponses
Bonjour Cocobat, bonjour le forum,
cocobat a écrit :dans un dossier j'ai un fichier pdf qui correspond la référence dans le fichier excel. Le but et d'analyser cette colonne et d'aller chercher dans un répertoire le fichier correspondant et de le copier dans un dossier qui portera le nom du classeur.
VBA permet des merveilles mais nécessite de la précision !... Tu parles d'un dossier source et d'un dossier destination. Où se trouvent-t-ils, comment les définir ? Quand on sait cela la moitié du problème est résolue...
c
Bonjour et merci de ta rapidité,
L'organisation est la suivante :
Le fichier excel se trouve à des endroit variable mais toujours sur C:\
Le dossier source se trouve sur un lecteur X:\Documentations (Webdav)
Le dossier destination se trouve sur C:\Users\xxxxx\Documents\CloudSVD\Dossier de doc (l'idéal serait de pouvoir choisir le dossier de destination par une boite de dialogue mais bon...)
Merci
Re,
le code ci-dessous à placer dans un fichier de ton choix. Ensuite :
- • Ouvre le fichier
• Lances la Macro1 qui :
- - Ouvre une boîte de dialogue te permettant d'ouvrir le classeur Origine (qui contient la liste)
- Copie tous les fichiers du dossier source contenu dans la liste dans le dossier destination (qui correspond) au non du classeur Origine). Si le dossier n'existe pas, la macro le crée...
Il te faudra adapter :
- • Le chemin d'accès complet du dossier destination
• Le nom de l'onglet où se trouve la liste
• La colonne COL
Le code :
Sub Macro1()
Dim DS As String 'déclare la varaible DS (Dossier Source)
Dim DD As String 'déclare la varaible DD (Dossier Destination)
Dim SF As Object 'déclare la varaible SF (Systeme de Fichiers)
Dim FD As FileDialog 'déclare la varaible FD (File Dialog)
Dim CO As Workbook 'déclare la varaible CO (Classeur Origine)
Dim OO As Worksheet 'déclare la varaible OO (Onglet Origine)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim ND As String 'déclare la variable ND (Nouveau Dossier)
Dim DC As Object 'déclare la varaible DC (Dossier de Copie)
Dim F As String 'déclare la variable F (Fichier)
DS = "X:\Documentations (Webdav)" & "\" 'définit le dossier source DS
DD = "C:\Users\xxxxx\Documents\CloudSVD\Dossier de doc" 'définit le dossier destination DD
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
Set FD = Application.FileDialog(msoFileDialogFilePicker) 'définit la boîte de dialogue FD (permet d'ouvrir le fichier origine)
FD.AllowMultiSelect = False 'n'aurotise pas la sélection multiple
FD.Show 'affiche la boîte de dialogue
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier n'est sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'oubre le fichier sélectionné
Set CO = ActiveWorkbook 'définit le classeur origine CO
Set OO = CO.Worksheets("Feuil1") 'définit l'onglet origine OO (à adapter à ton cas)
Set FD = Nothing 'vide la varaible FD
COL = 1 'définit la colonne COL (à adapter à ton cas)
DL = OO.Cells(Application.Rows.Count, COL).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne COL de l'onglet OO
ND = Replace(CO.Name, ".xlsx", "") 'définit le nouveau dossier ND (le nom du fichier origine sans l'extension)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir (DD & ND & "\") 'change le répertoire du dossier courant (génére une erreur si le dossier n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
Set DC = SF.CreateFolder(DD & ND) 'définit le dossier de copie DC
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
F = Dir(DS & "*.pdf") 'définit le premier fichier PDF du dossier ayant DS pour chemin d'accès
Do While F <> "" 'boucle tant qu'il existe de fichiers F
For I = 1 To DL 'boucle sur toutes les ligne I de la colonne COL (de 1 à DL)
'si la valeur de la cellule ligne I colonne COL + ".pdf" est égale à F, copie le fichier F dans le dossier de copie et sort de la boucle
If OO.Cells(I, COL).Value & ".pdf" = F Then SF.copyfile DS & F, DD & ND & "\" & F: Exit For
Next I 'prochaine ligne de la boucle
F = Dir 'féfinit le fichier PDF F suivant du dossier ayant DS pour chemin d'accès
Loop 'boucle
CO.Close SaveChanges:=False 'ferme le classeur origine
End SubJ'ai testé avec des dossiers sur mon PC et ça fonctionne !...
c
et béh qu'un seul mot a dire merci beaucoup
Je teste ça et je te dirais
c
Bon ça marche du tonnerre !
Merci merci merci tu peux même pas imaginer le temps gagné grâce à ça !
Une possibilité de sortir la liste des PDF non trouvé par rapport a la liste excel ? en gros une liste d'erreur...
c
Un petit souci tout de même dans mon dossier source si j'ai des sous dossiers ils ne sont pas pris en compte...
Re,
A tester :
Sub Macro1()
Dim DS As String 'déclare la variable DS (Dossier Source)
Dim DD As String 'déclare la variable DD (Dossier Destination)
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim FD As FileDialog 'déclare la variable FD (File Dialog)
Dim CO As Workbook 'déclare la variable CO (Classeur Origine)
Dim OO As Worksheet 'déclare la variable OO (Onglet Origine)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim ND As String 'déclare la variable ND (Nouveau Dossier)
Dim DC As Object 'déclare la variable DC (Dossier de Copie)
Dim F As String 'déclare la variable F (Fichier)
Dim DP As Object 'déclare la variable DP (Dossier des Pdf)
Dim TEST As Boolean 'déclare la variable TEST
Dim DPP As Object 'déclare la variable DPP (Dossier Principal des Pdf)
Dim SDP As Object 'déclare la variable SDP (Sous Dossier des Pdf)
Dim SDE As Object 'déclare la variable SDE (Sous Dossier d'Extraction)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
'DS = "X:\Documentations (Webdav)" & "\" 'définit le dossier source DS
'DD = "C:\Users\xxxxx\Documents\CloudSVD\Dossier de doc" & "\" 'définit le dossier destination DD
DS = "\\serveur\PUB\ALCAPOWER" & "\" 'définit le dossier source DS
DD = "\\serveur\PUB\poubelle\Rusht" & "\" 'définit le dossier destination DD
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
Set FD = Application.FileDialog(msoFileDialogFilePicker) 'définit la boîte de dialogue FD (permet d'ouvrir le fichier origine)
FD.AllowMultiSelect = False 'n'aurotise pas la sélection multiple
FD.Show 'affiche la boîte de dialogue
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier n'est sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'ouvre le fichier sélectionné
Set CO = ActiveWorkbook 'définit le classeur origine CO
Set OO = CO.Worksheets("Feuil1") 'définit l'onglet origine OO (à adapter à ton cas)
Set FD = Nothing 'vide la variable FD
COL = 1 'définit la colonne COL (à adapter à ton cas)
DL = OO.Cells(Application.Rows.Count, COL).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne COL de l'onglet OO
ND = Replace(CO.Name, ".xlsx", "") 'définit le nouveau dossier ND (le nom du fichier origine sans l'extension)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir (DD & ND & "\") 'change le répertoire du dossier courant (génére une erreur si le dossier n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
Set DC = SF.CreateFolder(DD & ND) 'définit le dossier de copie DC
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
For I = 1 To DL 'boucle 1 : sur toutes les ligne I de la colonne COL (de 1 à DL)
TEST = False 'réinitialise la variable TEST
F = Dir(DS & "*.pdf") 'définit le premier fichier pdf du dossier ayant DS pour chemin d'accès
Do While F <> "" 'boucle tant qu'il existe de fichiers F
If OO.Cells(I, COL).Value & ".pdf" = F Then 'condition : si la valeur de la cellule ligne I colonne COL + ".pdf" est égale à F
SF.CopyFile DS & F, DD & ND & "\" & F 'copie le fichier F dans le dossier de copie
TEST = True 'définie la variable TEST
GoTo suite 'va à l'étiquette "suite"
End If 'fin de la condition
F = Dir 'féfinit le fichier pdf F suivant du dossier ayant DS pour chemin d'accès
Loop 'boucle
Set DPP = SF.GetFolder(DS) 'définit le dossier pricipal des pdf DPP
Set SDP = DPP.SubFolders 'définit l'ensemble des sous-dossiers SDP du dossier principal DPP
For Each SDE In SDP 'boucle 2 : sur tous les sous dossier-d'extaction SDE de l'ensemble SDP
F = Dir(SDE & "\*.pdf") 'définit le premier fichier pdf du dossier ayant SDE pour chemin d'accès
Do While F <> "" 'boucle tant qu'il existe de fichiers F
If OO.Cells(I, COL).Value & ".pdf" = F Then 'condition : si la valeur de la cellule ligne I colonne COL + ".pdf" est égale à F
SF.CopyFile SDE & "\" & F, DD & ND & "\" & F 'copie le fichier F dans le dossier de copie
TEST = True 'définie la variable TEST
GoTo suite 'va à l'étiquette "suite"
End If 'fin de la condition
F = Dir 'définit le fichier pdf suivant F du dossier ayant SDE pour chemin d'accès
Loop 'boucle
Next SDE 'prochain sous-dossier
suite: 'étiquette
If TEST = False Then MSG = MSG & Chr(13) & OO.Cells(I, COL).Value & ".pdf non trouvé !" 'si TEST est [FAUX] redéfinit le message MSG
Next I 'prochaine ligne de la boucle
CO.Close SaveChanges:=False 'ferme le classeur origine
MsgBox MSG 'Message
End Subc
ça plante la :
F = Dir(DS & "*.pdf") 'définit le premier fichier pdf du dossier ayant DS pour chemin d'accès
erreur d’exécution...
je n'avais pas cette erreur sur le premier code
le code que j'ai modifié avec mes dossier
Sub DossierDeDoc2()
Dim DS As String 'déclare la variable DS (Dossier Source)
Dim DD As String 'déclare la variable DD (Dossier Destination)
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim FD As FileDialog 'déclare la variable FD (File Dialog)
Dim CO As Workbook 'déclare la variable CO (Classeur Origine)
Dim OO As Worksheet 'déclare la variable OO (Onglet Origine)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim ND As String 'déclare la variable ND (Nouveau Dossier)
Dim DC As Object 'déclare la variable DC (Dossier de Copie)
Dim F As String 'déclare la variable F (Fichier)
Dim DP As Object 'déclare la variable DP (Dossier des Pdf)
Dim TEST As Boolean 'déclare la variable TEST
Dim DPP As Object 'déclare la variable DPP (Dossier Principal des Pdf)
Dim SDP As Object 'déclare la variable SDP (Sous Dossier des Pdf)
Dim SDE As Object 'déclare la variable SDE (Sous Dossier d'Extraction)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
DS = "C:\Dossier de doc\doc" & "\" 'définit le dossier source DS
DD = "C:\Dossier de doc\dossier" 'définit le dossier destination DD
DS = "\\serveur\PUB\ALCAPOWER" & "\" 'définit le dossier source DS
DD = "\\serveur\PUB\poubelle\Rusht" & "\" 'définit le dossier destination DD
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
Set FD = Application.FileDialog(msoFileDialogFilePicker) 'définit la boîte de dialogue FD (permet d'ouvrir le fichier origine)
FD.AllowMultiSelect = False 'n'aurotise pas la sélection multiple
FD.Show 'affiche la boîte de dialogue
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier n'est sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'ouvre le fichier sélectionné
Set CO = ActiveWorkbook 'définit le classeur origine CO
Set OO = CO.Worksheets("Feuil1") 'définit l'onglet origine OO (à adapter à ton cas)
Set FD = Nothing 'vide la variable FD
COL = 1 'définit la colonne COL (à adapter à ton cas)
DL = OO.Cells(Application.Rows.Count, COL).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne COL de l'onglet OO
ND = Replace(CO.Name, ".xlsx", "") 'définit le nouveau dossier ND (le nom du fichier origine sans l'extension)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir (DD & ND & "\") 'change le répertoire du dossier courant (génére une erreur si le dossier n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
Set DC = SF.CreateFolder(DD & ND) 'définit le dossier de copie DC
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
For i = 1 To DL 'boucle 1 : sur toutes les ligne I de la colonne COL (de 1 à DL)
TEST = False 'réinitialise la variable TEST
F = Dir(DS & "*.pdf") 'définit le premier fichier pdf du dossier ayant DS pour chemin d'accès
Do While F <> "" 'boucle tant qu'il existe de fichiers F
If OO.Cells(i, COL).Value & ".pdf" = F Then 'condition : si la valeur de la cellule ligne I colonne COL + ".pdf" est égale à F
SF.CopyFile DS & F, DD & ND & "\" & F 'copie le fichier F dans le dossier de copie
TEST = True 'définie la variable TEST
GoTo suite 'va à l'étiquette "suite"
End If 'fin de la condition
F = Dir 'féfinit le fichier pdf F suivant du dossier ayant DS pour chemin d'accès
Loop 'boucle
Set DPP = SF.GetFolder(DS) 'définit le dossier pricipal des pdf DPP
Set SDP = DPP.SubFolders 'définit l'ensemble des sous-dossiers SDP du dossier principal DPP
For Each SDE In SDP 'boucle 2 : sur tous les sous dossier-d'extaction SDE de l'ensemble SDP
F = Dir(SDE & "\*.pdf") 'définit le premier fichier pdf du dossier ayant SDE pour chemin d'accès
Do While F <> "" 'boucle tant qu'il existe de fichiers F
If OO.Cells(i, COL).Value & ".pdf" = F Then 'condition : si la valeur de la cellule ligne I colonne COL + ".pdf" est égale à F
SF.CopyFile SDE & "\" & F, DD & ND & "\" & F 'copie le fichier F dans le dossier de copie
TEST = True 'définie la variable TEST
GoTo suite 'va à l'étiquette "suite"
End If 'fin de la condition
F = Dir 'définit le fichier pdf suivant F du dossier ayant SDE pour chemin d'accès
Loop 'boucle
Next SDE 'prochain sous-dossier
suite: 'étiquette
If TEST = False Then MSG = MSG & Chr(13) & OO.Cells(i, COL).Value & ".pdf non trouvé !" 'si TEST est [FAUX] redéfinit le message MSG
Next i 'prochaine ligne de la boucle
CO.Close SaveChanges:=False 'ferme le classeur origine
MsgBox MSG 'Message
End Subc
c'est bon fichier modifié ca marche
t'es un chef
merci pour tout je vais rajouté quelques trucs je te donnerais le résultat
merci
Re,
Il manque & "\" au dossier DD :
DD = "C:\Dossier de doc\dossier" & "\" 'définit le dossier destination DDIl faut bien évidemment que tu supprimes ces deux lignes (que j'aie oublier de faire moi-même) :
DS = "\\serveur\PUB\ALCAPOWER" & "\" 'définit le dossier source DS
DD = "\\serveur\PUB\poubelle\Rusht" & "\" 'définit le dossier destination DDÀ tester :