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

Résolu
dianedg Messages postés 22 Date d'inscription   Statut Membre Dernière intervention   -  
dianedg Messages postés 22 Date d'inscription   Statut Membre Dernière intervention   -
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
A voir également:

2 réponses

Réponse 1 / 2
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
dianedg Messages postés 22 Date d'inscription   Statut Membre Dernière intervention   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
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > dianedg Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
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
Réponse 2 / 2
dianedg Messages postés 22 Date d'inscription   Statut Membre Dernière intervention   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