XL 2010 déplacement d'un fichier dans un autre dossier

[philmaure]

bonjour,

Est -il possible de déplacer un fichier Excel d'un dossier dans un autre dossier sachant que le nom du fichier est partiellement inconnu puisqu'il a soit une date en tête du nom soit à la fin : exemple

19_10_2016_toto..xls dans le dossier Jour à déplacer dans le dossier Archive

ou

toto_19_10_216.xls dans le dossier Jour à déplacer dans le dossier Archive

J'ai trouvé sur e forum la manière de déplacer un fichier d'un dossier vers un autre fichier mais seulement lorsque le nom du fichier est connu en totalité.

Merci pour votre aide
Cdlt
Philmaure

 

[Theze]

Bonjour,

Une piste pour trouver le fichier avec une partie du nom. Le dossier doit exister et être connu sinon, il faudra utiliser une fonction récursive pour savoir où se trouvent les classeurs :

Sub Test()

    Dim Tbl() As String
    Dim Chemin As String
    Dim Ctritere As String
    Dim Extension As String
    Dim I As Integer
   
    Chemin = "D:\Mon dossier\" '<-- le dossier doit exister !
    Ctritere = "toto"
    Extension = ".xls"
   
    'appel de la fonction...
    'seuls les classeurs contenant le critère et l'extension précisée seront retournés, à adapter...
    Tbl() = RecupFichiers(Chemin, Ctritere, Extension)
   
    'si le tableau a été initialisé...
    If Not Not Tbl Then
   
        For I = 1 To UBound(Tbl)
       
            Debug.Print Tbl(I)
            'le code de déplacement...
           
        Next I
       
    End If
   
End Sub

Function RecupFichiers(Chemin As String, Critere As String, Extension As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
   
    If Left(Extension, 1) <> "." Then Extension = "." & Extension
   
    Fichier = Dir(Chemin & "*" & Critere & "*" & Extension)
   
    Do While (Len(Fichier) > 0)
   
        I = I + 1
       
        ReDim Preserve TableauFichiers(1 To I)
       
        TableauFichiers(I) = Fichier
       
        Fichier = Dir()
       
    Loop
   
    RecupFichiers = TableauFichiers()

End Function

 

[philmaure]

bonjour et un grand merci pour la solution

le dossier existe bien. tout est ok

Cdlt
Philmaure