Ajouter un dossier parent à un dossier en fonction de son nom

Version imprimable

03/11/2015, 13h04
oOBaalberithOo

Ajouter un dossier parent à un dossier en fonction de son nom

Bonjour,
Je viens demander votre aide pour faire fasse au problème suivant :

J'ai une liste de dossiers ayant comme nom un numéro (entre 12000 et 12300) et un horodatage se présentant de tel manière :

12000_09022015
12001_16032015
12002_25022015
12003_19102015
...

Et j'aimerais que chaque dossier ait un dossier parent ayant comme nom uniquement le numéro :

12000
|_12000_09022015
12001
|_12001_16032015
12002
|_12002_25022015
12003
|_12003_19102015
...

Si vous pouviez éclairer ma lanterne... :)
03/11/2015, 13h41
hackoofr

:salut:
Exemple de dossier 12000_09022015
Vous voulez dire créer un dossier parent 12000 et déplacer le dossier concerné 12000_09022015 dans le dossier parent 12000 ? c'est ça ?
03/11/2015, 14h24
oOBaalberithOo

:salut:
C'est exactement ça ! :)

:salut:
Testez cette solution en Vbscript :

Code:

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
Option Explicit
Dim Dossier,SourceFolder,DestinationFolder,Ws
SourceFolder = Browse4Folder()
DestinationFolder = SourceFolder
Call Scan4Folder(SourceFolder)
MsgBox "Le script est terminé by Hackoo !",VbInformation,"Script est terminé by Hackoo !"
Set Ws = CreateObject("wscript.shell")
ws.run "Explorer " & DblQuote(DestinationFolder)
'**************************************************************************
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 Scan4Folder(Folder)
    Dim fso,objFolder,Dossier
    Dim Tab,LeDossier,NewFolderName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    For Each Dossier in objFolder.SubFolders
        Tab = Split(Dossier.Name,"_")
        NewFolderName = Tab(0)
        BuildFullPath(DestinationFolder & "\" & NewFolderName)
        Set LeDossier = fso.GetFolder(Dossier)
        LeDossier.Move DestinationFolder & "\" & NewFolderName & "\"
        Msgbox "Le dossier " & DblQuote(Dossier) & " est déplacé dans " & vbcr &_
        DblQuote(DestinationFolder & "\" & NewFolderName),vbInformation,DblQuote(Dossier)    
    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
'*********************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'*********************************************************************

03/11/2015, 16h12
oOBaalberithOo

Merci hackoofr ça marche du tonnerre !:yaisse2:
Vous m'enlevez une épine du pied ! Je me voyais mal me taper tout ça manuellement !
:merci:
03/11/2015, 16h22
hackoofr

Citation:

Envoyé par oOBaalberithOo

Merci hackoofr ça marche du tonnerre !:yaisse2:
Vous m'enlevez une épine du pied ! Je me voyais mal me taper tout ça manuellement !
:merci:

Je te dois alors un +1 :plusser: :mouarf:
NB: si vous avez plusieurs dossiers à déplacer vous pouvez alors supprimer le MsgBox pour aller plus vite ;)
03/11/2015, 16h25
oOBaalberithOo

Oui c'est ce que j'ai fait, il y en a environ 300 et sûrement + par la suite donc bon... :mouarf: