Deplacement de fichiers dans un nouveau dossier

bonjour à tous .....

decidement je vais vous solliciter + + ..... voilà, on me demande de créer des macros pour faciliter notre boulot......

le problème du jour.......

tout les matin, nous avons des fichiers mp3 d'enregistrements qui arrivent dans un dossier (toujours le même) ..... ces différents enregistrements (fichiers mp3) doivent être classés dans des dossiers aux noms des "proprietaires".... et ces dossiers proprietaires dans un unique dossier renommé à la date du jour - 1 !!!!

comment faire cette boucle ?

les noms des fichiers ont tous cette forme ACCALB_20140102-130234_1679107_1012-all.mp3...........

ce qui change est le "1012" par exemple qui est en fait le code du "proprietaire".......

quelqu'un peut il m'aider sur ça ? si j'ai été assez clair?

merci à tous pour votre aide

Bonjour,

Cette fonction personnalisée te permettra d'isoler le numéro du propriétaire (4 caractères!).

A adapter dans tes procédures.

Cdlt

Option Explicit
Public Function Proprietaire(S As String) As String
Dim tmp
    tmp = Split(S, "_")
    Proprietaire = Left(tmp(3), 4)
End Function

Ok et merci Bcp , mais comment créer des dossiers automatiques en fonction de ce numéro isoles? Et comment créer un dossier a la date du jour? Merci de l aide

bonjour,

bon j'ai pu avancer sur cette macro..... j'arrive à selectionner les dossiers en fonction de la selection que je voulais et les coller dans des dossier nommés selon ce code......voici le code:

Sub Macro1()

'

DeplacerFichiers "F:\Enregistrements_SOPHIA\"

End Sub

Sub DeplacerFichiers(DosDestination As String)

Dim Fso As Object

Dim Dossier As Object

Dim Fichier As Object

Dim NouvDos As Object

'crée l'objet

Set Fso = CreateObject("Scripting.FileSystemObject")

'si le dossier cible n'existe pas, fin

If Fso.FolderExists(DosDestination) = False Then Exit Sub

'défini le dossier où effectuer la recherche des fichiers et la création des dossiers

Set Dossier = Fso.GetFolder(DosDestination)

'parcour la collection de fichiers du dossier en cours

For Each Fichier In Dossier.Files

'si le dossier portant le nom du fichier existe, le fichier est déplacé dans ce dossier

'sinon, le dossier est créé et le fichier est ensuite placé dedans

If Fso.FolderExists(Dossier & "\" & UCase(Mid(Fichier.Name, InStrRev(Fichier.Name, ".") - 8, 4))) = True Then

Fso.MoveFile Fichier, Dossier & "\" & UCase(Mid(Fichier.Name, InStrRev(Fichier.Name, ".") - 8, 4)) & "\" & Fichier.Name

Else

Set NouvDos = Fso.CreateFolder(Dossier & "\" & UCase(Mid(Fichier.Name, InStrRev(Fichier.Name, ".") - 8, 4)))

Fso.MoveFile Fichier, NouvDos & "\" & Fichier.Name

End If

Next Fichier

End Sub

par contre..... petite question.....

1/ existe il une solution pour savoir combien il y a de fichiers dans chaque dossier crée?

merci à tous

Bonjour,

A tester avec une fonction personnalisée.

Public Function CompteLesFichiers(Chemin As String) As Long
Dim fs as variant, RepFich As Variant
    Set fs = CreateObject("Scripting.FileSystemObject")
    CompteLesFichiers = fs.GetFolder(Chemin).Files.Count
    For Each RepFich In fs.GetFolder(Chemin).SubFolders
        CompteLesFichiers = CompteLesFichiers + CompteLesFichiers(RepFich.path)
    Next RepFich
End Function

Syntaxe d'utilisation de la fonction.

Sub CompterFichiers()
Dim chemin As String
    chemin = "D:\Doc\" 'avec ou sans sous-répertoire
    MsgBox CompteLesFichiers(chemin)
End Sub

re,

merci pour la réponse rapide.....

bon ça marche..... le problème est que j'ai le nombre total de fichiers.... or je cherche à avoir le nombre de fichier dans chaque sous dossier crée.........

une solution?

Re,

Fais une recherche sur

fs.GetFolder(Chemin).SubFolders

La réponse est peut être là.

bonsoir jean eric et les autres.....

ce que je cherche à faire serait "dans l'ideal" qu'il m'affiche une message box avec les noms des dossiers et le nombre de fichiers dans chaque .....et pas un nombre total......

mais ça..... je pense que c'est impossible à mon niveau ....

merci pour votre aide et vos réponses