Discussion :

[zeuch]

Bonjour,

Je cherche à copier une liste de fichiers qui sont tous dans un même dossier vers des dossiers différents.

Les noms des fichiers sont composées ainsi:
[N° de 4 à 6 caractères]-[Date au format AAAAMMJJ]-[N° de 1 à 4].extension

Exemples :

2788-20150909-1
12345-20150909-2
265478-20150909-4


Je voudrais pouvoir copier ces fichiers dans des dossiers (existants ou non) nommés comme le code avant le premier tiret

Exemple:

2788-20150909-1 --> copié dans dossier nommé "2788"
12345-20150909-2 --> copié dans dossier nommé "12345"
265478-20150909-4 --> copié dans dossier nommé "265478"

Malheureusement ça dépasse un peu (beaucoup ) mes compétences en script...

Merci d'avance !

[hackoofr]

Peut-être une solution en Vbscript :

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
Option Explicit
Dim File,MyRootFolder,RootFolder
MyRootFolder = Browse4Folder
Call Scan4File(MyRootFolder)
MsgBox "Script Done !",VbInformation,"Script Done !"
'**************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Please select a folder "
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,0,0)
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
End Function
'****************************************************************************
Function Scan4File(Folder)
    Dim fso,objFolder,FileName
    Dim Tab,aFile,NewFolderName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    For Each FileName in objFolder.Files
        Tab = Split(FileName,"-")
        NewFolderName = Tab(0)
        Msgbox NewFolderName
        BuildFullPath(NewFolderName)
        Set aFile = fso.GetFile(FileName)
        aFile.Copy NewFolderName & "\"    
    Next
End Function
'*****************************************************************************
Sub BuildFullPath(ByVal FullPath)
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(FullPath) Then
        BuildFullPath fso.GetParentFolderName(FullPath)
        fso.CreateFolder FullPath
    End If
End Sub
'*****************************************************************************

[zeuch]

Merci pour ta réponse c'est super!

J'ai adapté (avec mes maigres connaissances) pour rentrer en dur le chemin d'origine (c:\temp) de mes fichiers.
Par contre je ne sais pas comment je peux mettre en dur un chemin de destination

une petite idée ?

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
Option Explicit
Dim File,MyRootFolder,RootFolder
MyRootFolder = Browse4Folder
Call Scan4File(MyRootFolder)
MsgBox "Script Done !",VbInformation,"Script Done !"
'**************************************************************************
Function Browse4Folder()
	Dim objFolder
	Dim objShell
    'Dim objShell,objFolder,Message
    'Message = "Please select a folder "
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace("c:\temp")
    If objFolder Is Nothing Then
    Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
End Function
'****************************************************************************
Function Scan4File(Folder)
    Dim fso,objFolder,FileName
    Dim Tab,aFile,NewFolderName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    For Each FileName in objFolder.Files
        Tab = Split(FileName,"-")
        NewFolderName = Tab(0)
        'Msgbox NewFolderName
        BuildFullPath(NewFolderName)
        Set aFile = fso.GetFile(FileName)
        aFile.Copy NewFolderName & "\"    
    Next
End Function
'*****************************************************************************
Sub BuildFullPath(ByVal FullPath)
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(FullPath) Then
        BuildFullPath fso.GetParentFolderName(FullPath)
        fso.CreateFolder FullPath
    End If
End Sub
'*****************************************************************************

[hackoofr]

Like this way

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
Option Explicit
Dim File,MyRootFolder
MyRootFolder = "c:\temp"
Call Scan4File(MyRootFolder)
MsgBox "Script Done !",VbInformation,"Script Done !"
'****************************************************************************
Function Scan4File(Folder)
    Dim fso,objFolder,FileName
    Dim Tab,aFile,NewFolderName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    For Each FileName in objFolder.Files
        Tab = Split(FileName,"-")
        NewFolderName = Tab(0)
        Msgbox NewFolderName
        BuildFullPath(NewFolderName)
        Set aFile = fso.GetFile(FileName)
        aFile.Copy NewFolderName & "\"    
    Next
End Function
'*****************************************************************************
Sub BuildFullPath(ByVal FullPath)
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(FullPath) Then
        BuildFullPath fso.GetParentFolderName(FullPath)
        fso.CreateFolder FullPath
    End If
End Sub
'*****************************************************************************

[zeuch]

Merci mais comment puis-je choisir le dossier de destination où seront copiés les fichiers ? Je m'explique:

Pour l'instant les fichiers sont copiés dans des dossiers avec le code présent dans le nom de fichier (super) mais ces dossiers sont dans c:\temp

Exemple:

c:\temp\1290\[fichier]

J'aimerais que les dossiers soient dans C:\result\1290\[fichier] par exemple.

Comment puis je faire ça ?


Merci!

[hackoofr]

Merci mais comment puis-je choisir le dossier de destination où seront copiés les fichiers ? Je m'explique:
Pour l'instant les fichiers sont copiés dans des dossiers avec le code présent dans le nom de fichier (super) mais ces dossiers sont dans c:\temp
Exemple:
c:\temp\1290\[fichier]
J'aimerais que les dossiers soient dans C:\result\1290\[fichier] par exemple.
Comment puis je faire ça ?
Merci!

Voulez-vous dire comme ceci :

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
Option Explicit
Dim File,SourceFolder,DestinationFolder
SourceFolder = "C:\temp"
DestinationFolder = "C:\result"
Call Scan4File(SourceFolder)
MsgBox "Script Done !",VbInformation,"Script Done !"
'****************************************************************************
Function Scan4File(Folder)
    Dim fso,objFolder,File
    Dim Tab,aFile,NewFolderName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    For Each File in objFolder.Files
        Tab = Split(File.Name,"-")
        NewFolderName = Tab(0)
        Msgbox DestinationFolder & "\" & NewFolderName
        BuildFullPath(DestinationFolder & "\" & NewFolderName)
        Set aFile = fso.GetFile(File)
        aFile.Copy DestinationFolder & "\" & NewFolderName & "\"    
    Next
End Function
'*****************************************************************************
Sub BuildFullPath(ByVal FullPath)
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(FullPath) Then
        BuildFullPath fso.GetParentFolderName(FullPath)
        fso.CreateFolder FullPath
    End If
End Sub
'*****************************************************************************