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

Résolu/Fermé

dianedg Messages postés 22 Date d'inscription mercredi 5 mars 2014 Statut Membre Dernière intervention 19 juillet 2016 - Modifié par dianedg le 13/12/2015 à 20:16
dianedg Messages postés 22 Date d'inscription mercredi 5 mars 2014 Statut Membre Dernière intervention 19 juillet 2016 - 2 janv. 2016 à 12:48

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:

Sélectionner quelques fichiers et non la totalité du répertoire
Wetransfer gratuit fichiers lourd - Guide
Comment réduire la taille d'un fichier - Guide
Renommer plusieurs fichiers - Guide
Explorateur de fichiers - Guide
Fichiers bin - Guide

2 réponses

Réponse 1 / 2

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
14 déc. 2015 à 08:40

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

dianedg Messages postés 22 Date d'inscription mercredi 5 mars 2014 Statut Membre Dernière intervention 19 juillet 2016 1
14 déc. 2015 à 22:28

Bonjour, merci pour cette réponse mais où dois-je ajouter cette partie exactement et dois-je supprimer qq lignes dans le code initial ?

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > dianedg Messages postés 22 Date d'inscription mercredi 5 mars 2014 Statut Membre Dernière intervention 19 juillet 2016
Modifié par f894009 le 15/12/2015 à 07:37

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

Réponse 2 / 2

dianedg Messages postés 22 Date d'inscription mercredi 5 mars 2014 Statut Membre Dernière intervention 19 juillet 2016 1
2 janv. 2016 à 12:48

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

Discussions similaires

Chemin Logo du site de la Cité de l'espace

Question PIX

comment donner les droits sur fichier partage

Discussions similaires

Newsletters