Discussion :

[crebuffet]

Bonjour,

Je cherche à l'aide d'une macro EXCEL à copier tous les fichiers portant un type d'extension (pdf, doc...) d'un répertoire connu vers le répertoire courant.

Merci de votre aide

christophe

[EngueEngue]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub copie()
Dim fichier As String, chemin as string, arrivee as string, extension as string
 
extension = "pdf"
chemin = "c:\"
fichier = Dir(chemin & "*." & extension)
arrivee =  "c:\la\"
 
do while Fichier <> ""
'ton code
loop
end sub

[Marc-L]

Bonjour,

voici une procédure complète …

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
Function ExistDir(ByVal Rep$) As Boolean
         If Right$(Rep, 1) = Application.PathSeparator Then Rep = Left$(Rep, Len(Rep) - 1)
               D$ = Dir(Rep, vbDirectory)
         ExistDir = D > "" And StrComp(D, Right$(Rep, Len(D)), vbTextCompare) = 0
End Function
 
 
Sub DirCopy(RepFic$, Optional Dest$)
    S$ = Application.PathSeparator
    P& = InStrRev(RepFic, S):  If P Then Dossier$ = Left$(RepFic, P)
 
    If ExistDir(Dossier) Then
        If Dest = "" Then Dest = CurDir
        If Not ExistDir(Dest) Then Beep: Exit Sub
        If Right$(Dest, 1) <> S Then Dest = Dest & S
        F = Dir(RepFic)
 
        Do While F > ""
            FileCopy Dossier & F, Dest & F
            F = Dir
        Loop
 
    Else
        Beep
    End If
End Sub
 
 
Sub Demo()
    DirCopy "D:\Tests\*.pdf"
End Sub

Si la destination n'est pas spécifiée (l'argument Dest) lors de l'appel de la procédure DirCopy,
le répertoire courant devient alors la destination …

Si un bip se fait entendre, un dossier passé en argument n'existe pas !


__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …