Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2795 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  copie de fichiers vers dossiers en fonction du nom de fichier

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

copie de fichiers vers dossiers en fonction du nom de fichier

n°1612214
anthony000​0
Posté le 17-09-2007 à 09:45:27  profilanswer
 

Bonjour,
 
Je cherche à copier une liste de fichiers qui sont tous dans un même dossier vers des dossiers différents.
 
Une partie du nom des fichiers comporte 4 ou 5 caractères (P001 ou P001a).
 
Un extrait :
 
AA009_P001_Img001
AA009_P001_Img002
AA009_P001_Img003
AA009_P002a_Img001
AA009_P002b_Img001
AA009_P002b_Img002
AA009_P003_Img001
 
Je voudrais pouvoir copier ces fichiers dans des dossiers déjà existants, eux-même dans le même dossier des fichiers.
 
AA009_P001_Img001  --> copié dans dossier nommé "P001"
AA009_P001_Img002  --> copié dans dossier nommé "P001"
AA009_P001_Img003  --> copié dans dossier nommé "P001"
AA009_P002a_Img001 --> copié dans dossier nommé "P002a"
AA009_P002b_Img001 --> copié dans dossier nommé "P002b"
AA009_P002b_Img002 --> copié dans dossier nommé "P002b"
AA009_P003_Img001  --> copié dans dossier nommé "P003"
 
 
J'ai déjà codé un petit peu en WScript mais ça fait longtemps, alors je pense que je pourrais peut-être m'en sortir juste avec quelques indications (enfin j'espère !)
 
Merci d'avance !


Message édité par anthony0000 le 17-09-2007 à 10:36:22
mood
Publicité
Posté le 17-09-2007 à 09:45:27  profilanswer
 

n°1612217
kiki29
Posté le 17-09-2007 à 10:05:08  profilanswer
 

Pour la partie vérification et création éventuelle du dossier : en VBA
A adapter à ton contexte


     .....
 if CreationDossier(CheminFichier) then
  ......
 Else
  MsgBox "Chemin d'accès introuvable"
  Exit Sub
 End If
     ......


 

Private Function CreationDossier(ByVal sPath As String) As Boolean
Dim i As Integer
Dim sTmp As String
Dim Ar() As String
     
    Ar = Split(sPath, "\" )
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(sPath, vbDirectory) = "" Then
        CreationDossier = False
    Else
        CreationDossier = True
    End If
End Function


Message édité par kiki29 le 17-09-2007 à 10:17:11
n°1612229
anthony000​0
Posté le 17-09-2007 à 10:28:35  profilanswer
 

Merci pour cette réponse très rapide !
 
Mais tout compte fait, ça ne me prendra que très peu de temps de créer une liste de dossier, donc je le fais à la main pour cette partie-là.
(je n'ai besoin que d'une ou deux secondes pour créer une liste de 40 dossiers, mais de 2 à 3 minutes pour déplacer les fichiers dans ces différents dossiers)
 
En tout cas, ça me permet de me remémorer petit à petit comment fonctionne le Wscript.

n°1612235
kiki29
Posté le 17-09-2007 à 10:34:19  profilanswer
 

Si tu préfères faire à la main qqch qui peut être automatisé

n°1612245
anthony000​0
Posté le 17-09-2007 à 10:47:43  profilanswer
 

Ah, désolé, désolé,
 
Tu me donnes une partie de la solution et je m'empresse de ne pas l'utiliser ^_^
 
Ce que je voulais dire, c'est que ça pourrait être plus simple pour le déplacement de fichier si les dossiers sont déjà existants.
C'est plutot ce que je me demande, je ne sais pas à quoi va ressembler le code au final, je n'ai pas les outil à ma disposition (notament la liste de toutes les fonctions en format hlp que j'ai égaré)
 
Je pense qu'une recherche de chaine de texte spécifique fonctionnerait.
Je m'explique, à chaque fois qu'il trouve un fichier donné, il le déplace dans un dossier donné (dans ce cas-là, la chaine de texte choisi est la même pour le fichier et le dossier)
En utilisant une boucle avec incrémentation ou un fichier texte avec les infos de recherche à lire je pense que ça ferait l'affaire.
Mais ma question est : quels sont les codes pour faire une recherche ?
 
Ou plutôt, où pourrais-je trouver le fichier dont je parlais (le fichier hlp) ?
 
 

n°1612254
kiki29
Posté le 17-09-2007 à 11:23:38  profilanswer
 

VBA Excel : Liste des noms de fichiers présents dans un Dossier
La recherche peut être récursive,à adapter au contexte
 
Dans VBE [Alt+F11] Outils | Références : Cocher Microsoft Scripting Runtime
 


Option Explicit
 
Const DossierRacine As String = "C:\Faq\FaqVba\Exemples\ListeFichiers"
Const TypeFichier As String = "xls"
Dim r As Long,c As Long
Dim cpt As Long
 
Sub Liste()
    ShImport.Cells.Clear
    r = 1: c = 1: cpt = 0
    ListeFichiersDansDossier DossierRacine, False
End Sub
 
Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)
 
    For Each Fichier In DossierSource.Files
        If UCase(FSO.GetExtensionName(Fichier.Name)) = UCase(TypeFichier) And Fichier.Name <> ThisWorkbook.Name Then
            With ShImport
                .Cells(r, c) = Fichier.Name
                .Cells(r, c + 1) = Fichier.ParentFolder
            End With
            cpt = cpt + 1
            r = r + 1
            Application.StatusBar = "Lecture noms : " & cpt
        End If
    Next Fichier
 
    If InclureSousDossiers Then
        For Each SousDossier In DossierSource.SubFolders
            ListeFichiersDansDossier SousDossier.Path, True
        Next SousDossier
        Set SousDossier = Nothing
    End If
 
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub


 
Faire un Split du nom de fichier avec "_" comme séparateur
dans le tableau résultant nommé par exemple Ar en Ar(1) tu auras le nom du dossier voulu
par exemple pour AA009_P002b_Img001 en faisant Ar=Split(NomDuFichier,"_" )  
Ar(1) contiendra P002b
 
Ce qui devrait donner


Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Dim Ar() As String
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)
 
    For Each Fichier In DossierSource.Files
        If UCase(FSO.GetExtensionName(Fichier.Name)) = UCase(TypeFichier) And Fichier.Name <> ThisWorkbook.Name Then
            With ShImport
                .Cells(r, c) = Fichier.Name
                .Cells(r, c + 1) = Fichier.ParentFolder
                If InStr(Fichier.Name, "_" ) > 0 Then
                    Ar = Split(Fichier.Name, "_" )
                    .Cells(r, c + 2) = Ar(1)
                End If
            End With
            cpt = cpt + 1
            r = r + 1
            Application.StatusBar = "Lecture noms : " & cpt
        End If
    Next Fichier
 
    If InclureSousDossiers Then
        For Each SousDossier In DossierSource.SubFolders
            ListeFichiersDansDossier SousDossier.Path, True
        Next SousDossier
        Set SousDossier = Nothing
    End If
 
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub


Message édité par kiki29 le 17-09-2007 à 11:33:33
n°1612256
anthony000​0
Posté le 17-09-2007 à 11:53:40  profilanswer
 

Merci pour tout, je vais regarder ça !

n°1612260
anthony000​0
Posté le 17-09-2007 à 12:14:06  profilanswer
 

En fait, j'avais l'habitude d'écrire mes scripts dans des fichiers vbs.
Il y aurait quelques lignes à changer dans ce cas ?


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  copie de fichiers vers dossiers en fonction du nom de fichier

 

Sujets relatifs
[VB6] : Supprimer le titre et numéro de page d'un fichier texteDoubles guillemets dans fonction mail()
Scripts VBS + DOS - sortie dans un fichier de logsCharge de travail d'une migration VB vers VB.NET / C# / JAVA
[C-preprocessor] L'inverse d'une fonction variadique[JS] Appel fonction d'une autre page
Compresser des .TXT en un fichier .ARJfonction if
[link] faire un .so a partir de "trop" de fichierscreat table en php avec une fonction en +
Plus de sujets relatifs à : copie de fichiers vers dossiers en fonction du nom de fichier


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR