Sélectionner quelques fichiers et non la totalité du répertoire

Résolu
dianedg Messages postés 23 Statut Membre -  
dianedg Messages postés 23 Statut Membre -
Bonjour,
J'ai le code suivant qui me permet d'appeler un répertoire et sélectionner tous les fichiers du répertoire pour les traiter (par une autre macro).
Cependant, j'aimerais sélectionner les fichiers à traiter dans ce répertoire et non traiter tous les fichiers automatiquement.
J'ai essayé avec l'option MultiSelect, mais j'ai des bug après (je débute en vba).
Pourriez-vous m'aider?
Merci d'avance,
Diane 

 
Sub Traitement()
    'creation de la liste des fichiers contenu dans le repertoire qui contient ce même fichier
    Dim Chemin As String, Fichier_csv As String, CompteurDeFichier As Integer
    Dim MessageFinDeTraitement As String, MaFeuille As Worksheet
    Dim Repertoire As FileDialog, Chemin_et_Fichier As String
    
    'fige ecran
    Application.ScreenUpdating = False
    'Selection d'un repertoire
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show     'boite a dialogue choix repertoire
    If Repertoire.SelectedItems.Count > 0 Then  'choix ok
        Chemin = Repertoire.SelectedItems(1)
  
        Fichier_csv = Dir(Chemin & "\*.csv") 'recupération 1er fichier .csv
        If Fichier_csv <> Empty Then    'fichier csv existe
            Do While Fichier_csv <> Empty 'boucle tant que fichier csv existe
                '-------------------- Traitement fichier csv----------------------
                Call Traitement_csv_xlsx(Chemin, Fichier_csv)
                '---------------------------------------------------------------------------------------------
                Fichier_csv = Dir ' suivant
            Loop
            Msg = "Terminé"
        Else
            Msg = "Aucun Fichier trouvé dans le répertoire " & Chemin & " ! "
        End If
        MsgBox Msg
    Else    'choix pas ok
        MsgBox "Aucun Répertoire Sélectionné"
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

2 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    modifiez le type de fichier 

    'selection multiple fichiers dans un repertoire
Sub Choix_fichiers()
    FichiersAOuvrir = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "SELECTION FICHIER(S) TEST", , True)
        If IsArray(FichiersAOuvrir) Then    'test selection multiple
            'code traitement selection fichiers
        End If
End Sub
    0
    1. dianedg Messages postés 23 Statut Membre 1
       
      Bonjour, merci pour cette réponse mais où dois-je ajouter cette partie exactement et dois-je supprimer qq lignes dans le code initial ?
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > dianedg Messages postés 23 Statut Membre
         
        Bonjour,

        votre code (qu'il me semble reconnaitre) modifie: 

        Sub Traitement()
    Dim FTF As Integer, N As Integer
    Dim FichiersAOuvrir
    
    'fige ecran
    Application.ScreenUpdating = False
    'boite dialogue selection fichier(s), True=multiple selection possible
    FichiersAOuvrir = Application.GetOpenFilename("CSV Files (*.csv),*.csv", , "SELECTION FICHIER(S) CSV", , True)
    If IsArray(FichiersAOuvrir) Then    'test selection multiple
        'code traitement selection fichiers
        FTF = UBound(FichiersAOuvrir)       'Nb fichiers selectionnes
        For N = 1 To FTF    'boucle fichier(s) csv
            '-------------------- Traitement fichier csv----------------------
            Call Traitement_csv(FichiersAOuvrir(N))
            '----------------------------------Chemin-----------------------------------------------------------
        Next N
        Msg = "Terminé"
    Else    'choix pas ok
        MsgBox "Aucun Fichier Sélectionné"
    End If
    Application.ScreenUpdating = True
End Sub
        0
  2. dianedg Messages postés 23 Statut Membre 1
     
    J'ai finalement opté pour une autre solution: déplacer les fichiers traités dans un nouveau dossier après traitement et les supprimer dans le dossier initial. Le code ne traite ainsi que les nouveaux fichiers créés non traités qui apparaissent dans le dossier initial (cf exemple).
    Merci pour votre aide.
    Diane 


    Sub FusionClasseurVial()

    Dim CheminXls As String
    Dim objOFSX As Variant

    'on définit les répertoires
    Const DossierXlsRawData = "C:\Users\Username\Desktop\Dossier initial\*.*"
    Const DossieurXlsProcessed = "C:\Users\Username\Desktop\Dossier traité\"

    CheminXls = "C:\Users\Username\Desktop\Dossier initial\"

    'code de traitement blabla

    'déplacement et suppression fichier csv
    Set objOFSX = CreateObject("Scripting.FileSystemObject")
    objOFSX.CopyFile DossierXlsRawData, DossieurXlsProcessed
    ChDir CheminXls
    Kill "*.xlsx"
    End Sub

    0

Discussions similaires

Chemin Logo du site de la Cité de l'espace
Keiios -
blux -

11 réponses
question pix mot caché
aorum10 -
pixlagalere -

7 réponses