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
A voir également:

2 réponses

f894009 Messages postés 17413 Statut Membre 1 715
 
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 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
f894009 Messages postés 17413 Statut Membre 1 715 > 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
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