Ouvrir fichiers csv automatiquement en fn de la date [Résolu]

Messages postés
4
Date d'inscription
dimanche 10 février 2008
Dernière intervention
30 mai 2011
- - Dernière réponse : berwerk
Messages postés
4
Date d'inscription
dimanche 10 février 2008
Dernière intervention
30 mai 2011
- 30 mai 2011 à 17:05
Bonjour à tous,
je cherche à implémenter une feuille constituée d'une liste de fichiers présents dans d'un une arborescence.
Mon but est:
Parcourir une arborecence
Rechercher les fichiers .csv
Récupérer 2 champs
Stocker le nom du fichier et les 2 champs dans une feuille.

Actuellement, je suis parvenu en partie à mon but en utilisant "FileSystemObject" trouvé dans un forum.
L'inconvénient est que l'import de ces données se font systématiquement sur tous les fichiers, ce qui est assez long.
Je cherche donc à réaliser l'import uniquement sur les fichiers qui ont été modifiés ou créés depuis la dernière opération.
En espèrant avoir été clair.
Merci
Afficher la suite 

Votre réponse

6 réponses

Meilleure réponse
Messages postés
42
Date d'inscription
mardi 24 mai 2011
Dernière intervention
12 juin 2012
3
Merci
Tu peux peut être y arriver en allant check la date de last modif avant d'importer le fichier.

look ici

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 117 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Vorens
Messages postés
42
Date d'inscription
mardi 24 mai 2011
Dernière intervention
12 juin 2012
0
Merci
La date figure dans le nom de ton fichier ou pas ?
(exemple monfichier27052011.cvs)
Commenter la réponse de Vorens
Messages postés
4
Date d'inscription
dimanche 10 février 2008
Dernière intervention
30 mai 2011
0
Merci
Hélas non
Je pensais utiliser .lastdatemodified mais sans succès.
Voici le code actuel que j'ai trouvé et adapté pour mon application:

[Code]
Option Explicit

' Dans VBE Outils | Références : Cocher Microsoft Scripting Runtime

Const DossierRacine As String = "c:\temp"

Dim r As Long

Sub Liste()
Application.ScreenUpdating = False

r = 1
ListeFichiersDansDossier DossierRacine, True

End Sub
Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)

' Ouvre les fichiers contenu dans un dossier et ses sous-dossiers
'
Dim FSO As Scripting.FileSystemObject ' Gestionnaire de fichiers Windows
Dim Nomdossiers As Scripting.Folders ' Collection des dossiers
Dim Nomfichiers As Scripting.Files ' Collection des fichiers
Dim ApplSelectionDossier As FileDialog ' Boite de dialogue d'ouverture de fichiers/dossiers
Dim DossierSource As Scripting.Folder

' Créer un objet de gestion des fichiers
Set FSO = New Scripting.FileSystemObject
' Affecte la liste des sous-dossiers du dossier sélectionné
Set Nomdossiers = FSO.GetFolder(NomDossierSource).SubFolders
' Affecte la liste des fichiers du dossier en-cours
Set Nomfichiers = FSO.GetFolder(NomDossierSource).Files
' Appel de la procédure d'ouverture des fichiers
Call Ouvrir_fichier(Nomdossiers, Nomfichiers)

End Sub

' Procédure de parcours de dossiers en mode récursif
Sub Ouvrir_fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)

Dim NomDossier As Scripting.Folder ' Propriétés Dossier
Dim NomFichier As Scripting.File ' Propriétés Fichier
Dim FSO As Scripting.FileSystemObject ' Gestionnaire de fichiers Windows

' S'il n'y a aps de fichiers dans le répertoire en cours
If Nomfichiers Is Nothing Then
' Rien
Else
' Pour chaque fichier de la liste de fichiers
For Each NomFichier In Nomfichiers
If Right(NomFichier, 4) ".csv" Or Right(NomFichier, 4) ".CSV" Then
' Ouvrir le fichier
Workbooks.Open FileName:=NomFichier

' ****************** Appeler la macro ici ***********************************

Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
TrailingMinusNumbers:=True
Rows("1:25").Select
Selection.Delete Shift:=xlUp
Range("A1").Value = ActiveWorkbook.Name

Cells.Select

Selection.Find(What:="PDAT", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("b1").Value = ActiveCell.Offset(2, 0).Value

Cells.Select

Selection.Find(What:="PEFR", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("c1").Value = ActiveCell.Offset(2, 0).Value / 100


Range("A1:c1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ActivateNext
Range("A65000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Application.CutCopyMode = False


'Ferme le fichier sans enregistrer
ActiveWorkbook.Close SaveChanges:=False
' ****************** Fin appel de la macro **********************************
' Fin si
End If
' fichier suivant
Next
' Fin si
End If
' S'il n'y a pas de sous-dossiers dans Nomdossier
If Nomdossiers Is Nothing Then
' Rien
Else
' Pour chaque dossier de la liste de dossiers
For Each NomDossier In Nomdossiers
' Créer un objet de gestion des fichiers
Set FSO = CreateObject("Scripting.FileSystemObject")
' Affecte la liste des fichiers du dossier en cours
Set Nomfichiers = FSO.GetFolder(NomDossier.Path).Files
' Appel la procédure d'ouverture des fichiers (récursif)
Call Ouvrir_fichier(NomDossier.SubFolders, Nomfichiers)
' Dossier suivant
Next NomDossier
' Fin si
End If

End Sub

[End Code]
Commenter la réponse de berwerk
Messages postés
42
Date d'inscription
mardi 24 mai 2011
Dernière intervention
12 juin 2012
0
Merci
Utiliser les balises code dispo sa rend le truc plus claire.

Option Explicit 

' Dans VBE Outils | Références : Cocher Microsoft Scripting Runtime 

Const DossierRacine As String = "c:\temp" 

Dim r As Long 

Sub Liste() 
Application.ScreenUpdating = False 

r = 1 
ListeFichiersDansDossier DossierRacine, True 

End Sub 
Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean) 

' Ouvre les fichiers contenu dans un dossier et ses sous-dossiers 
' 
Dim FSO As Scripting.FileSystemObject ' Gestionnaire de fichiers Windows 
Dim Nomdossiers As Scripting.Folders ' Collection des dossiers 
Dim Nomfichiers As Scripting.Files ' Collection des fichiers 
Dim ApplSelectionDossier As FileDialog ' Boite de dialogue d'ouverture de fichiers/dossiers 
Dim DossierSource As Scripting.Folder 

' Créer un objet de gestion des fichiers 
Set FSO = New Scripting.FileSystemObject 
' Affecte la liste des sous-dossiers du dossier sélectionné 
Set Nomdossiers = FSO.GetFolder(NomDossierSource).SubFolders 
' Affecte la liste des fichiers du dossier en-cours 
Set Nomfichiers = FSO.GetFolder(NomDossierSource).Files 
' Appel de la procédure d'ouverture des fichiers 
Call Ouvrir_fichier(Nomdossiers, Nomfichiers) 

End Sub 

' Procédure de parcours de dossiers en mode récursif 
Sub Ouvrir_fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files) 

Dim NomDossier As Scripting.Folder ' Propriétés Dossier 
Dim NomFichier As Scripting.File ' Propriétés Fichier 
Dim FSO As Scripting.FileSystemObject ' Gestionnaire de fichiers Windows 

' S'il n'y a aps de fichiers dans le répertoire en cours 
If Nomfichiers Is Nothing Then 
' Rien 
Else 
' Pour chaque fichier de la liste de fichiers 
For Each NomFichier In Nomfichiers 
If Right(NomFichier, 4) ".csv" Or Right(NomFichier, 4) ".CSV" Then 
' Ouvrir le fichier 
Workbooks.Open FileName:=NomFichier 

' ****************** Appeler la macro ici *********************************** 

Columns("A:A").Select 
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
:=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _ 
TrailingMinusNumbers:=True 
Rows("1:25").Select 
Selection.Delete Shift:=xlUp 
Range("A1").Value = ActiveWorkbook.Name 

Cells.Select 

Selection.Find(What:="PDAT", After:=ActiveCell, LookIn:=xlFormulas, _ 
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
MatchCase:=False, SearchFormat:=False).Activate 
Range("b1").Value = ActiveCell.Offset(2, 0).Value 

Cells.Select 

Selection.Find(What:="PEFR", After:=ActiveCell, LookIn:=xlFormulas, _ 
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
MatchCase:=False, SearchFormat:=False).Activate 
Range("c1").Value = ActiveCell.Offset(2, 0).Value / 100 


Range("A1:c1").Select 
Application.CutCopyMode = False 
Selection.Copy 
ActiveWindow.ActivateNext 
Range("A65000").End(xlUp).Offset(1, 0).Select 
ActiveSheet.Paste 
ActiveWindow.ActivateNext 
Application.CutCopyMode = False 


'Ferme le fichier sans enregistrer 
ActiveWorkbook.Close SaveChanges:=False 
' ****************** Fin appel de la macro ********************************** 
' Fin si 
End If 
' fichier suivant 
Next 
' Fin si 
End If 
' S'il n'y a pas de sous-dossiers dans Nomdossier 
If Nomdossiers Is Nothing Then 
' Rien 
Else 
' Pour chaque dossier de la liste de dossiers 
For Each NomDossier In Nomdossiers 
' Créer un objet de gestion des fichiers 
Set FSO = CreateObject("Scripting.FileSystemObject") 
' Affecte la liste des fichiers du dossier en cours 
Set Nomfichiers = FSO.GetFolder(NomDossier.Path).Files 
' Appel la procédure d'ouverture des fichiers (récursif) 
Call Ouvrir_fichier(NomDossier.SubFolders, Nomfichiers) 
' Dossier suivant 
Next NomDossier 
' Fin si 
End If 

End Sub 

Commenter la réponse de Vorens
Messages postés
4
Date d'inscription
dimanche 10 février 2008
Dernière intervention
30 mai 2011
0
Merci
Oups désolé, c'est mon premier post, j'ai vu comment faire maintenant.
Merci
Commenter la réponse de berwerk
Messages postés
4
Date d'inscription
dimanche 10 février 2008
Dernière intervention
30 mai 2011
0
Merci
Bonjour Vorens, merci pour ton aide, j'ai trouvé une solution.
pour info:
If DateDiff("D", Nomfichier.DateLastModified, Now) < 8 And Right(Nomfichier, 4) ".csv" Or Right(Nomfichier, 4) ".CSV" Then

Merci
Commenter la réponse de berwerk

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.