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 -
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
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
- Comment réduire la taille d'un fichier - Guide
- Renommer des fichiers en masse - Guide
- Fichiers epub - Guide
- Forcer la suppression d'un fichier - Guide
- Répertoire téléphonique gratuit - Télécharger - Bureautique
2 réponses
Bonjour,
modifiez le type de fichier
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
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
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
votre code (qu'il me semble reconnaitre) modifie: