Discussion :

[Ekimasu]

bonjour,

désespéremmen je pose cette question "simple",

comment copier un dossier A (c:\toto par exemple) ainsi que ce qu'il contient dans un dossier 2 (c:\temp par exemple) pour avoir au final c:\temp\toto


c'est pourtant simple !!

j'arrive pas à croire que la fonction FileCopy ne comprennent pas les répertoire !!! c'est dingue !

une idée ?

[ouskel'n'or]

A défaut d'autre chose, j'utilise ça :

Code :

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

1
2
MkDir "D:\Cabanes"
Call Shell("cmd /c copy D:\clipart\Cabanes\ D:\Cabanes\")

En attendant la solution d'un plus savant que nous...

A+

[Audren Kerboeuf]

J'ai une autre solution si tu preferes ne pas passser par une commande DOS :

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
 
'===============================
Private sub copier()
 
dim oldF as string
dim newF as string
dim resultat
 
oldF="C:\...\toto.txt"
newF="C:\...\temp\toto.txt"
resultat =op_copier(oldF, newF)
 End Sub
'===============================
function op_copier(SRC as string, DST as string)
 
fileCopy SRC, DST
 
End function
'===============================

Si tu n'utilises pas ton ficher,cette fonction marchera tout le temps et tu peux l'appeler autrement si tu le désires

@+

[Ekimasu]

ces solutions ne fonctionnent pas car mon répertoire source contient aussi des répertoires.

même la version DOS ne fonctionne pas

[Audren Kerboeuf]

Et bien j'en ai aussi des répertoires et cela fonctionne très bien (je le fais avec une base de données). Je change même de disque avec la fonction FileCopy.
Si ça ne marche pas, je ne peux pas t'aider désolé

@+

[Admin]

voila une fonction que j'utilise tout le temps pour faire ce que tu veux :

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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Option Compare Database
Option Explicit
 
'Déclaration des API
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'Constantes pour les API
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
 
 
 
'Type pour les API
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
'Cette fonction permet de supprimer le caractère de fin de chaine d'une chaine quelconque
    'Si on trouve le chr$(0) on rentre dans la boucle
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        'On prend les données à gauche de la chaine.
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    'on affecte la nouvelle chaine à l'argument de sortie.
    StripNulls = OriginalStr
End Function
 
 
Function CopyFilesAPI(path As String, SearchStr As String, filecount As Long, dircount As Long, path_dest As String)
 
 
'déclaration des variables
Dim filename As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim rs As DAO.Recordset
 
 
 
'si le chemin passé en argument n'a pas un \ on le rajoute
If Right(path, 1) <> "\" Then
    path = path & "\"
End If
 
    ' Recherche des sous répertoires
    nDir = 0
    'redimensionne ndir
    ReDim dirNames(nDir)
    Cont = True
 
    'on cherche le premier fichier
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        'on boucle tant que la structure renvoi un nouveau repertoire (vérification avec cont)
        Do While Cont
            DirName = StripNulls(WFD.cFileName)
            If (DirName <> ".") And (DirName <> "..") Then
                If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                    dirNames(nDir) = DirName
                    dircount = dircount + 1
                    nDir = nDir + 1
                    ReDim Preserve dirNames(nDir)
                    'on creer le repertoire destination si il n'existe pas
                    If Dir(path_dest & DirName, vbDirectory) = "" Then
                        MkDir (path_dest & DirName)
                    End If
 
                End If
            End If
            Cont = FindNextFile(hSearch, WFD)
        Loop
        Cont = FindClose(hSearch)
    End If
 
'fin de recherche des sous repertoire
 
'on attaque les fichiers
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
 
If hSearch <> INVALID_HANDLE_VALUE Then
    While Cont
        filename = StripNulls(WFD.cFileName)
        If (filename <> ".") And (filename <> "..") And GetAttr(path & filename) <> vbDirectory Then
            CopyFilesAPI = CopyFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
            filecount = filecount + 1
            'on ajoute le fichier dans la liste
            FileCopy path & filename, path_dest & filename
        End If
        Cont = FindNextFile(hSearch, WFD)
    Wend
    Cont = FindClose(hSearch)
End If
 
If nDir > 0 Then
    For i = 0 To nDir - 1
        'si on accepte les sous repertoire on s'appelle recursivement
        CopyFilesAPI = CopyFilesAPI + CopyFilesAPI(path & dirNames(i) & "\", SearchStr, filecount, dircount, path_dest & dirNames(i) & "\")
    Next i
End If
End Function
 
Public Sub test()
 
'i renvoi le nombre de fichier
 
Dim i As Long
 
'j renvoi le nombre de repertoire
Dim j As Long
 
'la fonction renvoi le nombre d'octet copié
CopyFilesAPI "C:\source\", "*.*", i, j, "c:\destination\"
 
End Sub

[Ekimasu]

bun voilà j'ai trouvé.

en 3 lignes, on peut le faire :

Set fso = CreateObject("Scripting.FileSystemObject")
Dim a
a = fso.CopyFolder"c:\toto", "c:\temp\", True)

True est pour autoriser l'overwrite..

merci moi :-)

[ridan]

On peut choisir les API pour leur rapidité :

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
Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Long
    hNameMaps As Long
    sProgress As String
End Type
 
Private Const FO_COPY = &H2
Private Const FOF_NOCONFIRMATION = &H10
 
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
     ByRef lpFileOp As SHFILEOPSTRUCT) As Long
 
 
Private Sub Form_Load()
 
Dim lpFileOp As SHFILEOPSTRUCT
 
With lpFileOp
    .wFunc = FO_COPY
    .pFrom = "C:\Sauvegarde"
    .pTo = "D:\"
    .fFlags = FOF_NOCONFIRMATION
End With
 
result = SHFileOperation(lpFileOp)
 
End Sub

[sozie9372]

Salut !

Code :

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

1
2
3
4
5
6
7
 
Dim fso as filesystemobject
set fso = new filesystemobject
' Copie
fso.CopyFolder "C:\Files", "C:\Files_Copy"
' Déplace
fso.MoveFolder "C:\Files", "C:\Files Move"

Voila !
+++
Ju[/code]

[Admin]

Bon bein je range mon de code de 12 km

[dbozec]