Discussion :

[Guizmonster]

Bonjour,

Je cherche à ouvrir et à récupérer automatiquement les données de plusieurs fichiers dont je connais partiellement les noms sur une clef USB.
Pour la première partie, j'utilise le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim FNAME As String
 
    MyPath = "D:\test"
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    MyFile = Dir(MyPath & "Pouet_Canard_Coin" & "*.csv", vbNormal)
    If Len(MyFile) = 0 Then
    Exit Sub
    End If
    Do While Len(MyFile) > 0
 
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        MyFile = Dir
    Loop
    Workbooks.OpenText MyPath & LatestFile, origin:=xlWindows, Local:=True
    FNAME = MyPath & LatestFile

J'arrive à récupérer le dernier fichier de chaque série de nom. Est-il par ailleurs possible de récupérer non pas le dernier mais l'avant dernier fichier de chaque série?

Comme les fichiers sont sur clé usb, j'aurais voulu m'affranchir de la lettre du lecteur en adaptant la formule suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Dim Lecteur As Variant
Dim L As Long
Lecteur = Array("D", "E", "F", "H")
 
For L = LBound(Lecteur) To UBound(Lecteur)
   File = Dir(Lecteur(L) & ":\fichiertest.csv")
   If Len(File) > 0 Then
      Workbooks.Open Filename:=Lecteur(L) & ":\fichiertest.csv"
      Exit For
   End If
Next L

J'ai tenté ce code-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim FNAME As String
    Dim Lecteur As Variant
    Dim L As Long
    Lecteur = Array("D", "E", "F", "H")
 
      For L = LBound(Lecteur) To UBound(Lecteur)
   MyPath = Dir(Lecteur(L) & ":\test")
   If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
   MsgBox MyPath, vbOKOnly
    MyFile = Dir(MyPath & "Pouet_Canard_Coin" & "*.csv", vbNormal)
 
   If Len(MyFile) = 0 Then
    Exit Sub
    End If
    Do While Len(MyFile) > 0
 
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        MyFile = Dir
    Loop
    Workbooks.OpenText MyPath & LatestFile, origin:=xlWindows, Local:=True
    FNAME = MyPath & LatestFile
    Next L

Avec l'affiche de la msgbox, je peux voir que déjà il ne prend pas la lettre du lecteur dans MyPath.
Avez-vous des idées?

Merci d'avance

[EricDgn]

Bonjour,

Quelque chose de ce genre (à vérifier, non testé):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
 
Sub OuvreDeuxieme(MyPath As String, MyFile As String)
 
    Dim MyPath As String
    Dim MyFile1 As String, MyFile2 As String, MyFileTmp As String
    Dim LMD1 As Date, LMD2 As Date, LMDtmp As Date
    Dim FNAME As String
 
    '--- premier fichier trouvé
    MyFile1 = Dir(MyPath & MyFile, vbNormal)
    If Len(MyFile1) = 0 Then
        Exit Sub
    End If
    LMD1 = FileDateTime(MyPath & MyFile1)
 
    '--- deuxième fichier trouvé
    MyFile2 = Dir
    If Len(MyFile2) = 0 Then
        Exit Sub
    End If
    LMD2 = FileDateTime(MyPath & MyFile2)
 
    '--- mise en ordre de date
    If LMD2 > LMD1 Then
        LMDtmp = LMD2:          LMD2 = LMD1:        LMD1 = LMDtmp
        MyFileTmp = MyFile2:    MyFile2 = MyFile1:  MyFile1 = MyFileTmp
    End If
 
    '--- fichiers suivants
    Do
        MyFileTmp = Dir
        If Len(MyFileTmp) = 0 Then Exit Do
        LMDtmp = FileDateTime(MyPath & MyFileTmp)
        If LMDtmp > LMD2 Then
            If LMDtmp > LMD1 Then
                LMD2 = LMD1:        LMD1 = LMDtmp
                MyFile2 = MyFile1:  MyFile1 = MyFileTmp
            Else
                LMD1 = LMDtmp
                MyFile2 = MyFileTmp
            End If
        End If
    Loop
    Workbooks.OpenText MyPath & MyFile2, origin:=xlWindows, Local:=True
    FNAME = MyPath & MyFile2
End Sub
 
Sub ListeUSB()
 
    Dim MyPath As String
    Dim MyFile As String
    Dim Lecteur As Variant
    Dim L As Long
 
    Lecteur = Array("D", "E", "F", "H")
 
    For L = LBound(Lecteur) To UBound(Lecteur)
        MyPath = Lecteur(L) & ":\test"
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        MyFile = "Pouet_Canard_Coin" & "*.csv"
        OuvreDeuxieme MyPath, MyFile
    Next L
End Sub

mais qui devrait ouvrir le 2e trouvé dans chacun des lecteurs. A adapter pour trouver le 2e parmi tous les lecteurs.
Cordialement

[Zeabon]

Bonjour à tous,

Vu que la solution de changement de lecteur de EricDgn marche, je serais partie sur une solution plus proche de celle de Guizmonster :
(FNAME = Dernier fichier, FNAME2 = Avant dernier fichier)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LatestFile2 As String
    Dim LatestDate2 As Date
    Dim LMD As Date
    Dim FNAME As String
    Dim FNAME2 As String
    Dim Lecteur As Variant
    Dim L As Long
 
    Lecteur = Array("D", "E", "F", "H")
 
    For L = LBound(Lecteur) To UBound(Lecteur)
        MyPath = Lecteur(L) & ":\test"
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        MyFile = "Pouet_Canard_Coin" & "*.csv"
        MyFile = Dir(MyPath & MyFile, vbNormal)
 
        If Len(MyFile) <> 0 Then
            Do While Len(MyFile) > 0
                LMD = FileDateTime(MyPath & MyFile)
                If LMD > LatestDate2 Then
                    LatestFile2 = MyFile
                    LatestDate2 = LMD
                    FNAME2 = MyPath & MyFile
                End If
                If LMD > LatestDate Then
                    LatestFile2 = LatestFile
                    LatestDate2 = LatestDate
                    FNAME2 = FNAME
                    LatestFile = MyFile
                    LatestDate = LMD
                    FNAME = MyPath & LatestFile
                End If
                MyFile = Dir
            Loop
        End If
    Next L
 
    Workbooks.OpenText FNAME2, origin:=xlWindows, Local:=True

Zeabon

[MarcelG]

Salut,

Pour s'affranchir du lecteur réseau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
 (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
 Option Compare Text
 
Public Function fnctGetUNCPath(ByVal PathName As String) As String
 
Const MAX_UNC_LENGTH  As Integer = 512
Dim strUNCPath As String
Dim strTempUNCName As String
Dim lngReturnErrorCode  As Long
 
  strTempUNCName = String(MAX_UNC_LENGTH, 0)
  lngReturnErrorCode = WNetGetConnection(Left(PathName, 2), strTempUNCName, _
    MAX_UNC_LENGTH)
 
  If lngReturnErrorCode = 0 Then
     strTempUNCName = Trim(Left(strTempUNCName, InStr(strTempUNCName, vbNullChar) - 1))
     strUNCPath = strTempUNCName & Mid(PathName, 3)
  End If
 
fnctGetUNCPath = strUNCPath
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Public Function monfullname() As String
Dim fnm As String
fnm = ThisWorkbook.FullName
monfullname = IIf(Len(fnctGetUNCPath(fnm)) = 0, fnm, fnctGetUNCPath(fnm))
End Function

A tester sur la procédure suivante;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub essai()
Debug.Print monfullname
End Sub

[MarcelG]

Salut,

Pour ouvrir l'avant dernier fichier modifié.

D'après le processus reporté par la FAQ, il suffit d'alimenter une variable tableau par les noms de fichiers et leur date de modification, triées par ordre décroissant.
Ensuite, considérer le 2ème item. Ici Tableau(1,2)

Activer la référence MICROSOFT SCRIPTING RUNTIME

A adapter en fonction de l'extension (.xls, .xlsm,....)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
 Sub triDecroissant_Fichiers_DateModif()
 
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
 
    Dim Fichier As String, Chemin As String
    Dim Fso As Scripting.FileSystemObject
    Dim FileItem As Scripting.File
    Dim Tableau()
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant
 
    '---liste les fichiers du répertoire ---
    Chemin = "lechemincomplet"
    'A adapter
    Fichier = Dir(Chemin & "\*.xlsm")
 
    'Boucle sur les fichiers
    Do
 
        m = m + 1
        ReDim Preserve Tableau(1 To 2, 1 To m)
        Tableau(1, m) = Fichier
 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
 
        'Pour récupérer la date de dernière modification
        Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        Fichier = Dir
    Loop Until Fichier = ""
 
 
    '---Trie les fichiers par ordre décroissant de modification ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
                For z = 1 To 2
                    Cible = Tableau(z, i)
                    Tableau(z, i) = Tableau(z, i + 1)
                    Tableau(z, i + 1) = Cible
                Next z
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
 Workbooks.Open Filename:=Chemin & "\" & CStr(Tableau(1, 2))
 
End Sub

[Guizmonster]

Bonjour à tous,

Merci pour toutes vos réponses (merci tardif lié à une très longue absence).
Du coup j'ai eu le temps de réfléchir et me mettre une contrainte sur l'avant dernier fichier est excessif pour le gain apporté. Comme après je peux récupérer dans chaque fichier les dates et heure, je peux utiliser ces données pour les classer dans mon fichier final.

Du coup je suis reparti sur ce code qui fonctionne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim FNAME As String
    Dim Lecteur As Variant
    Dim L As Long
 
    Lecteur = Array("D", "E", "F", "H")
 
    For L = LBound(Lecteur) To UBound(Lecteur)
        MyPath = Lecteur(L) & ":\Biere"
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        MyFile = "*sprititueux_vin_" & "*.csv"
        MyFile = Dir(MyPath & MyFile, vbNormal)
 
        If Len(MyFile) <> 0 Then
            Do While Len(MyFile) > 0
                LMD = FileDateTime(MyPath & MyFile)
                If LMD > LatestDate2 Then
                    LatestFile = MyFile
                    LatestDate = LMD
                    FNAME = MyPath & MyFile
                End If
                MyFile = Dir
            Loop
        End If
    Next L
 
    Workbooks.OpenText FNAME, origin:=xlWindows, Local:=True
    
 Actions que je dois faire le fichier une fois ouvert

ActiveWorkbook.Close
 
    Kill (FNAME)

J'ai 2 améliorations à faire. Comme je supprime le fichier une fois que j'ai récupérer les données avec la commande Kill, je dois le fermer auparavant. Je n'arrive pas à le faire par un workbooks.close mais seulement par un activeworkbook.close ce qui nécessite de revenir dans la fenêtre.

Enfin comment faire pour que la macro tourne tant qu'il trouve un fichier dans le dossier et s'arrête proprement à la fin.

Edit:

J'ai avancé sur le code et je suis confronté à un autre problème, celui du format du CSV qui doit être un format anglais ou un truc de ce genre. Je n'arrive pas à le mettre en pièce jointe sur le cite donc je colle lien ci-dessous.
https://drive.google.com/file/d/1xif...ew?usp=sharing
Après je dois retravailler le fichier. N'étant pas informaticien, ce que je fais n'est pas très joli.

Je viens remplacer les . par des , et après les valeurs stockées sous un format texte sont retransformer en nombre. Je vire les trucs qui ne me servent à rien (utc+2 par exemple) et je veux le coller dans mon fichier final à la suite des autres. Et c'est là le problème. Si je fais du copier coller manuellement, cela fonctionne.
Si je copie avec du VBA, soit les données reviennent sous un format texte ou alors j'ai des erreurs 1004 ou 438 suivant le .paste ou pastespecial
Si vous avez des idées?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
Sub anionsGB2()
 
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim FNAME As String
    Dim Lecteur As Variant
    Dim L As Long
 
    Lecteur = Array("D", "E", "F", "H")
 
    For L = LBound(Lecteur) To UBound(Lecteur)
        MyPath = Lecteur(L) & ":\alcool"
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        MyFile = "*biere" & "*.csv"
        MyFile = Dir(MyPath & MyFile, vbNormal)
 
        If Len(MyFile) <> 0 Then
            Do While Len(MyFile) > 0
                LMD = FileDateTime(MyPath & MyFile)
                If LMD > LatestDate2 Then
                    LatestFile = MyFile
                    LatestDate = LMD
                    FNAME = MyPath & MyFile
                End If
                MyFile = Dir
            Loop
        End If
    Next L
 
    Workbooks.OpenText FNAME, origin:=xlWindows, Local:=True
 
   'Mise en forme des données
 
        'remplacement des . par ,
 
        Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Cells.Replace What:="invalide", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        'Remplacer données sous format txt en chiffres
 
        For Each C In Range("c3:m3")
        C.Value = CDec(C)
        Next
 
        'Mise en forme date et reste des valeurs
 
        Range("C3:M3").Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
        Range("a3").Replace What:="UTC+2", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
        Range("a3").Replace What:="-", Replacement:="/", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
        Range("B3").ClearContents
 
        'Copie vers mon fichier
 
        Range("A3:k3").Copy
        ActiveWorkbook.Close savechanges:=False
 
 
        Windows("monfichier.xlsm").Activate
        Sheets("feuil1").Select
        Range("a12").End(xlDown).Offset(1, 0).PasteSpecial
 
 
 
    'Kill (FNAME)
 
 
End Sub

Bien cordialement