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
| Sub CopieRepertoires()
'Il faut activer la référence "MicroSoft Scripting Runtime" au prélable
Dim SourcePath, DestinationPath As String
Dim ff
Dim j As Long
Dim FileExt As String
SourcePath = "C:\Users\" 'à adapter
DestinationPath = "C:\Users\Public\" 'à adapter
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each ff In FSO.GetFolder(SourcePath).Files
FileExt = FSO.GetExtensionName(SourcePath & ff)
If UCase(FileExt) Like "PDF" Then
Debug.Print ff.Name
FSO.CopyFolder SourcePath, DestinationPath, True
j = j + 1
End If
Next ff
Set FSO = Nothing
MsgBox j & " fichiers ont été copiés de '" & SourcePath & "' vers '" & DestinationPath & "'", _
vbInformation + vbOKOnly, "Copie de fichiers PDF"
End Sub |
Partager