Discussion :

[Métry_Lop]

Bonjour,

Je souhaiterai avoir un programme vba visant à ouvrir l'explorateur de fichier, afin de sélectionner un fichier Word (ainsi que sa version PDF) et de les copier dans un dossier spécifique.

Est-ce que quelqu'un aurait une idée de comment coder le programme?

Merci d'avance

[Belga16]

Copier/coller ce code dans un module VBA, adapter les répertoires source et destination et activer la référence "MicroSoft Scripting Runtime", via le menu "Outils"

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub CopierDesFichiers()
    '****** Il faut activer la référence "MicroSoft Scripting Runtime" au prélable *******
On Error GoTo GererErreur
 
    Dim fDialog As Object
    Dim varFile As Variant
    Dim choix As Boolean
    Dim FichierChoisi As String
    Dim monFichier, Repertoire
    Dim CheminSource, CheminDestination As String
    Dim myMsg As String
    Dim ListeF() As String
    Dim j As Integer
 
    choix = False
    CheminSource = "C:\Users\XYZ\Documents\"        'à adapter
    CheminDestination = "C:\Users\Public\"        'à adapter
    FichierChoisi = ""
    Set fDialog = Application.FileDialog(1)
 
    With fDialog
       .AllowMultiSelect = True
       .InitialFileName = CheminSource
       .Title = "Choisissez les fichiers à copier"
 
       .Filters.Clear
       .Filters.Add "All Files", "*.PDF; *.Doc*"
 
        If .Show = True Then
            For Each varFile In .SelectedItems
                FichierChoisi = varFile
                Repertoire = FichierChoisi
                CheminSource = Left(Repertoire, InStrRev(Repertoire, "\"))
                monFichier = Mid(Repertoire, 1 + InStrRev(Repertoire, "\"))
                ReDim Preserve ListeF(j)
                ListeF(j) = FichierChoisi
                j = j + 1
            Next varFile
            choix = True
        Else
           MsgBox "Vous n'avez choisi aucun fichier!", vbExclamation, "Choix du fichier à importer"
           Exit Sub
        End If
 
        Set FSO = CreateObject("Scripting.FileSystemObject")
        For j = LBound(ListeF) To UBound(ListeF)
            FSO.CopyFile ListeF(j), CheminDestination & Mid(ListeF(j), 1 + InStrRev(ListeF(j), "\")), True
        Next j
    End With
 
GererErreur_Exit:
    Exit Sub
 
GererErreur:
    MsgBox "Erreur de traitement : " & Err & "; " & erorr
    Resume GererErreur_Exit
 
End Sub

[Métry_Lop]

Super c'est exactement ca!
Quelle ligne dois-je ajouter afin que les fichiers ajouté dans le dossier remplace ceux qui ont le même nom?
Merci d'avance!

[Belga16]

L'argument "True" dans l'expression :

Code :

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

FSO.CopyFile ListeF(j), CheminDestination & Mid(ListeF(j), 1 + InStrRev(ListeF(j), "\")), True

permet de remplacer un fichier existant ayant le même nom

[Métry_Lop]

Super Merci beaucoup!