Discussion :

[Nico451]

Bonjour,

Dans mon User forme je peux aller chercher un dossier contenant plusieurs fichiers (Donc lourds), je voudrait lors de la copie que la fenêtre de copie Windows s'ouvre pour afficher le temps qu'il reste sans passer par la barre de progression qu'offre Excel.

Merci de votre aide

[marot_r]

Bonjour.

Je pense que ce que tu cherches est là :

http://www.freevbcode.com/ShowCode.asp?ID=498

Ça appelle la fonction de copie de Windows. C'est comme un copier coller dans l'explorateur.

A+

[Nico451]

Merci pour le lien, il faut que je teste mais je ne sais pas encore comment faire, je ne vois pas comment le mettre en place.

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 
Private Sub CommandButton6_Click()
Dim Mypath As String
Dim Folder As String
Dim oFSO As Scripting.FileSystemObject
Dim source$, dest$, Dos$
Dim DSource As String
Dim Mypath1 As String
Dim NewName As String
Dim fso  As Scripting.FileSystemObject
Dim fd  As Scripting.Folder
Dim sFolderName  As String
Dim sNewName  As String
Dim sTemp  As String
Dim Date1 As String
Dim Time1 As String
 
 
    Mypath = Parent & "\projets\" & TextBox21 & "\" & "Dossier"
    Mypath1 = Parent & "\projets\" & TextBox21 & "\"
 
        If DossierExiste(Mypath) = True Then
 
                With Application.FileDialog(msoFileDialogFolderPicker)
                         .AllowMultiSelect = False
                    If .Show = -1 Then
                        'MsgBox "The path is: " & .SelectedItems(1)
                        DSource = .SelectedItems(1)
                    End If
 
                End With
 
 
             ' Initialisation des noms de dossiers
             sFolderName = Mypath
             Date1 = Replace(Date, "/", "-")
             Time1 = Replace(Time, ":", ".")
             'sFolderName = "Dossier"
             sNewName = "Dossier" & "_old_" & Date1 & " " & Time1
 
             Set fso = CreateObject("Scripting.FileSystemObject")
             ' Vérifier que le dossier source existe bien.
             If fso.FolderExists(sFolderName) Then
                 ' Récupérer l'instance du dossier.
                 Set fd = fso.GetFolder(sFolderName)
                 'sTemp = fd.Drive & "\" & sNewName
                 sTemp = Mypath1 & sNewName
 
                ' Vérifier que le dossier cible n'existe pas déjà.
                 If fso.FolderExists(sTemp) Then
                     MsgBox "Ce nom de dossier existe déjà!"
                 Else
                     If DSource = "" Then
                         MsgBox "Dossier non sélectionner!"
                     Else
                         fd.Name = sNewName
                        MsgBox "Le dossier " & sFolderName & " a été renommé en " & sNewName & " !"
 
                     source = DSource
                     dest = Parent & "\projets\" & TextBox21 & "\"
 
                     Set oFSO = New Scripting.FileSystemObject
 
 
                     If Not oFSO.FolderExists(dest) Then MkDir (dest)
                        oFSO.CopyFolder source, dest, True        'Application.Dialogs(xlDialogOpen).Show
                     End If
                 'MsgBox "Le dossier existe...", , "Dossier"
                 End If
            Else
                MsgBox "Dossier non trouvé!"
            End If
    End If
 
    If DossierExiste(Mypath) = False Then
 
                With Application.FileDialog(msoFileDialogFolderPicker)
                         .AllowMultiSelect = False
                    If .Show = -1 Then
                        'MsgBox "The path is: " & .SelectedItems(1)
                        DSource = .SelectedItems(1)
                    End If
 
                End With
 
                source = DSource
                dest = Parent & "\projets\" & TextBox21 & "\"
 
                Set oFSO = New Scripting.FileSystemObject
 
 
                If Not oFSO.FolderExists(dest) Then MkDir (dest)
                   oFSO.CopyFolder source, dest, True        'Application.Dialogs(xlDialogOpen).Show
                End If
    'End If
 
 
End Sub

[marot_r]

Bonjour.

Pas sur du sens de ta question donc il se peut que je réponde à côté.

Tu sélectionnes le code du site tu le copies dans un module.
Après tu n'as plus qu'à appeler APIFileCopy au lieu de CopyFile.

A+