Celui ci me créer des dossier du type « 1001-2023-10 »,« 1002-2023-12 ».
je voudrais déplacer tous les dossiers que ca me créer dans plusieurs dossiers
exemple celui ci « 1002-2023-12 » vers un dossier « 1001 » et celui la « 1002-2023-12 » vers un dossier « 1002 ».
En gros je voudrais que ca déplace tous mes dossiers suivant les 4 premiers chiffres dans le dossier correspondant a ceux la.
Merci d’avance pour votre aide
Au passage je voudrais bien comprendre un peu comment ca fonctionne
J’ai vu avec mon employeur pour avoir une formation excel vba ca devrait m’aider je pense
Sans fichier et nom de dossier en exemple, il est difficile de tester votre demande si j’ai bien compris celle-ci.
Pour commencer, vous devez indiquer le chemin où se trouvent vos dossiers. Pour cela, vous faites un copier-coller de votre explorateur sur cette partie du code :
Le script extrait les 4 premiers chiffres du nom de chaque dossier pour déterminer son dossier parent. Si ce dossier parent n’existe pas déjà, il est créé.
Finalement, chaque dossier est déplacé vers son dossier parent correspondant.
Sub DeplacerDossiers()
Dim fs As Object
Set fs = CreateObject(« Scripting.FileSystemObject »)
Dim dossierPrincipal As String
dossierPrincipal = "C:\MesDossiers" ' Modifier selon le chemin de vos dossiers
Dim dossier As Object
Dim nomDossierParent As String
Dim cheminDossierParent As String
' Parcourir chaque dossier dans le dossier principal
For Each dossier In fs.GetFolder(dossierPrincipal).SubFolders
' Extraire les 4 premiers chiffres du nom du dossier pour déterminer le dossier parent
nomDossierParent = Left(dossier.Name, 4)
cheminDossierParent = dossierPrincipal & "\" & nomDossierParent
' Vérifier si le dossier parent existe, sinon le créer
If Not fs.FolderExists(cheminDossierParent) Then
fs.CreateFolder(cheminDossierParent)
End If
' Déplacer le dossier vers son dossier parent
On Error Resume Next ' Ignorer les erreurs en cas de déplacement impossible
fs.MoveFolder dossier.Path, cheminDossierParent & "\"
On Error GoTo 0 ' Retour à la gestion normale des erreurs
Next
Set fs = Nothing
Bonjour et merci de ton aide
.
Le nom des fichiers correspond a ce que j’ai écrit plus haut (exemple: 1001-2023-10) et les fichiers dans se dossier sont de se type ( exemple: 1001 BI029 201977).
De se que je vois de ton script tu as bien compris ce que je voulais mais ca bloque des le début chez moi.
Je te joins un screen car je comprends pas
L’erreur de syntaxe semble provenir de l’utilisation des guillemets français (« ») au lieu des guillemets droits (") pour entourer les chaînes de caractères et les identifiants d’objets.
Sub DeplacerDossiers()
Dim fs As Object
Set fs = CreateObject(« Scripting.FileSystemObject »)
Dim dossierPrincipal As String
dossierPrincipal = « C:\MesDossiers » ’ Modifier selon le chemin de vos dossiers
Dim dossier As Object
Dim nomDossierParent As String
Dim cheminDossierParent As String
’ Parcourir chaque dossier dans le dossier principal
For Each dossier In fs.GetFolder(dossierPrincipal).SubFolders
’ Extraire les 4 premiers chiffres du nom du dossier pour déterminer le dossier parent
nomDossierParent = Left(dossier.Name, 4)
cheminDossierParent = dossierPrincipal & "" & nomDossierParent
' Vérifier si le dossier parent existe, sinon le créer
If Not fs.FolderExists(cheminDossierParent) Then
fs.CreateFolder cheminDossierParent
End If
' Déplacer le dossier vers son dossier parent
On Error Resume Next ' Ignorer les erreurs en cas de déplacement impossible
fs.MoveFolder dossier.Path, cheminDossierParent & "\"
On Error GoTo 0 ' Retour à la gestion normale des erreurs
