recherche repertoire et sous repertoire

Le
steph b
Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer et
ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie tous
les fichiers .pdf de ce répertoire et tous les sous répertoires et me copie
les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
DanielCo
Le #23275711
Bonjour,
Colle le code suivant dans un module standard :

Public Ligne As Long
Sub ListeDossiers()
Const DossierRacine As String = "d:donneesdaniel"
Sheets.Add
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(DossierRacine)
Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
For Each f In dossier.Files
If Right(f.Name, 4) = ".pdf" Then
Ligne = Ligne + 1
Cells(Ligne, 1) = f.Path
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d
Next
End Sub

Daniel


Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer et
ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie tous les
fichiers .pdf de ce répertoire et tous les sous répertoires et me copie les
PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.
isabelle
Le #23275851
bonjour steph,

pour choisir le repertoire,

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function

avec la macro de Daniel,
remplace cette ligne
Const DossierRacine As String = "d:donneesdaniel"
par
Const DossierRacine As String = ChoixDossier


isabelle
------------------------------------------------------------------

Le 2011-04-11 07:46, steph b a écrit :
Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer et
ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie tous
les fichiers .pdf de ce répertoire et tous les sous répertoires et me copie
les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.



steph b
Le #23275841
merci mais ce n est pas exactement ce que je cherche
je cherche pas listing je cherche à copier les fichiers directement dans un
repertoire

"DanielCo" inuqan$muh$
Bonjour,
Colle le code suivant dans un module standard :

Public Ligne As Long
Sub ListeDossiers()
Const DossierRacine As String = "d:donneesdaniel"
Sheets.Add
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(DossierRacine)
Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
For Each f In dossier.Files
If Right(f.Name, 4) = ".pdf" Then
Ligne = Ligne + 1
Cells(Ligne, 1) = f.Path
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d
Next
End Sub

Daniel


Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer
et ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie
tous les fichiers .pdf de ce répertoire et tous les sous répertoires et
me copie les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.





isabelle
Le #23275981
bonjour,

regarde le fil "classement de fichier" initier le 2011-03-30

isabelle
------------------------------------------------------------------

Le 2011-04-11 08:24, steph b a écrit :
merci mais ce n est pas exactement ce que je cherche
je cherche pas listing je cherche à copier les fichiers directement dans un
repertoire

"DanielCo" inuqan$muh$

Bonjour,
Colle le code suivant dans un module standard :

Public Ligne As Long
Sub ListeDossiers()
Const DossierRacine As String = "d:donneesdaniel"
Sheets.Add
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(DossierRacine)
Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
For Each f In dossier.Files
If Right(f.Name, 4) = ".pdf" Then
Ligne = Ligne + 1
Cells(Ligne, 1) = f.Path
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d
Next
End Sub

Daniel



Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer
et ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie
tous les fichiers .pdf de ce répertoire et tous les sous répertoires et
me copie les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.










steph b
Le #23276041
J ai vu merci mais je n arrive pas a combiner les deux macros


"steph b" 4da2f339$0$7709$
merci mais ce n est pas exactement ce que je cherche
je cherche pas listing je cherche à copier les fichiers directement dans
un repertoire

"DanielCo" inuqan$muh$
Bonjour,
Colle le code suivant dans un module standard :

Public Ligne As Long
Sub ListeDossiers()
Const DossierRacine As String = "d:donneesdaniel"
Sheets.Add
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(DossierRacine)
Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
For Each f In dossier.Files
If Right(f.Name, 4) = ".pdf" Then
Ligne = Ligne + 1
Cells(Ligne, 1) = f.Path
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d
Next
End Sub

Daniel


Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer
et ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie
tous les fichiers .pdf de ce répertoire et tous les sous répertoires et
me copie les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.









DanielCo
Le #23276091
Public DossierCible As String
Sub ListeDossiers()
Const DossierRacine As String = "d:donneesdaniel"
DossierCible = "c:tempTOUS LES PDF"
DossierCible = "c:temp"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(DossierRacine)
Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
For Each f In dossier.Files
If Right(f.Name, 4) = ".pdf" Then
Source = f.Path
cible = DossierCible & "" & f.Name
FileCopy Source, cible
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d
Next
End Sub

Remplace :
Const DossierRacine As String = "d:donneesdaniel"
par le code d'isabelle pour choisir le dossier.
Daniel


J ai vu merci mais je n arrive pas a combiner les deux macros


"steph b" 4da2f339$0$7709$
merci mais ce n est pas exactement ce que je cherche
je cherche pas listing je cherche à copier les fichiers directement dans un
repertoire

"DanielCo" inuqan$muh$
Bonjour,
Colle le code suivant dans un module standard :

Public Ligne As Long
Sub ListeDossiers()
Const DossierRacine As String = "d:donneesdaniel"
Sheets.Add
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(DossierRacine)
Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
For Each f In dossier.Files
If Right(f.Name, 4) = ".pdf" Then
Ligne = Ligne + 1
Cells(Ligne, 1) = f.Path
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d
Next
End Sub

Daniel


Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer
et ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie
tous les fichiers .pdf de ce répertoire et tous les sous répertoires et
me copie les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.









steph b
Le #23276181
merci à vous deux ca marche bien
well done

"isabelle" inurrv$qv5$
bonjour steph,

pour choisir le repertoire,

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function

avec la macro de Daniel,
remplace cette ligne
Const DossierRacine As String = "d:donneesdaniel"
par
Const DossierRacine As String = ChoixDossier


isabelle
------------------------------------------------------------------

Le 2011-04-11 07:46, steph b a écrit :
Bonjour,

Je voudrais une macro qui me demande un repertoire sous forme d'explorer
et
ensuite une fois e répertoire sélectionné. j'aimerais qu'il me copie tous
les fichiers .pdf de ce répertoire et tous les sous répertoires et me
copie
les PDF sous un répertoire créé nommé (" TOUS LES PDF")

est ce possible?

merci d'avance.






Publicité
Poster une réponse
Anonyme