Ouvrir fichiers csv automatiquement en fn de la dateRésolu

Question

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

Vorens · Accepted Answer

Tu peux peut être y arriver en allant check la date de last modif avant d'importer le fichier.

look ici

Vorens · Answer

La date figure dans le nom de ton fichier ou pas ?
(exemple monfichier27052011.cvs)

berwerk · Answer

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:	emp"

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]

Vorens · Answer

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:	emp" 

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

berwerk · Answer

Oups désolé, c'est mon premier post, j'ai vu comment faire maintenant.
Merci

berwerk · Answer

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

Ouvrir fichiers csv automatiquement en fn de la date

6 réponses

Votre réponse

Discussions similaires