Problème de reconnaissance d'un fichier txt

Bonjour à tous,

J'ai écris un code pour aller chercher un dossier puis dans chacun des sous dossiers chercher le fichier finissant par geo, l'ouvrir et faire une soustraction entre la 1ére et la dernière valeur de la colonne A.

Seulement quand je l'essaye, il ne trouve jamais le fichier. est-ce que quelqu'un peut m'aider ?

Voici mon code :

Sub test()
    Dim dossierPrincipal As String
    Dim dossierActuel As String
    Dim fichierGeoTxt As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim premiereValeur As Double
    Dim derniereValeur As Double
    Dim resultatSoustraction As Double
    Dim title As String
    Dim dialog As Object

    ' Spécifie le dossier principal
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    With dialog
        .title = "Sélectionner un dossier"
        .Show
        If .SelectedItems.Count > 0 Then
        ChoisirDossier = .SelectedItems(1)
        End If
    End With
    ' Vérifie si un dossier a été sélectionné
    If ChoisirDossier = "" Then
        MsgBox "Aucun dossier sélectionné. Le traitement est annulé."

    End If

    ' Boucle à travers les sous-dossiers du dossier principal
    dossierActuel = Dir(ChoisirDossier & "\*", vbDirectory)

    Do While dossierActuel <> ""
        ' Exclut les dossiers système
        If dossierActuel <> "." And dossierActuel <> ".." Then
            ' Spécifie le chemin du fichier Geo
            fichierGeoTxt = ChoisirDossier & "\" & dossierActuel & "\" & "23110800si11.geo"

            ' Vérifie si le fichier Geo existe
            If Dir(fichierGeoTxt) <> "" Then
                ' Ouvre le fichier Geo
                Set wb = Workbooks.Open(fichierGeoTxt)
                Set ws = wb.Sheets(1)

                ' Convertit la colonne A en nombre
                ws.Columns("A:A").NumberFormat = "0"

                ' Récupère la première et la dernière valeur
                premiereValeur = ws.Cells(1, 1).Value
                derniereValeur = ws.Cells(ws.Rows.Count, 1).End(xlUp).Value

                ' Effectue la soustraction
                resultatSoustraction = derniereValeur - premiereValeur

                ' Ferme le fichier GeoTxt
                wb.Close False

                ' Affiche le résultat dans une fenêtre pop-up
                MsgBox "Dans le dossier " & dossierActuel & ", la soustraction est : " & resultatSoustraction
            Else
                MsgBox "Aucun fichier GeoTxt trouvé dans le dossier " & dossierActuel
            End If
        End If

        ' Passe au dossier suivant
        dossierActuel = Dir
    Loop

End Sub

Merci d'avance pour votre aide !

dans cette version j'avais essayé de forcé le nom du fichier mais sans succés :(

Bonjour,

D'une part, les appels à la fonction DIR ne peuvent pas être imbriqués et d'autre part l'attribut vbDirectory prend en compte les fichiers de type dossier mais n'exclue pas les fichiers "ordinaires". Faites l'essai dans la fenêtre "Exécution" de l'éditeur VBE, avec un 1er appel "? DIR(<NomDuDossier> & "\*", vbDirectory" puis ensuite uniquement "? DIR" en le faisant successivement vous aurez ".", ".." puis des noms de fichier ou de dossier.

Il faut utiliser l'objet FileSystemObject de la bib "Microsoft Scripting Runtime" à ajouter via "Outils" / "Références ...". Sur le site, vous avez plein d'exemples de parcours de dossiers et de traitement des fichiers qui y sont inclus.

Cdlt,

Cylfo

Bonjour et merci pour ta réponse, tu m'as un peu perdu ^^

j'ai activé ce que tu m'a dit mais je n'ai jamais utilisé cette fonction :/

bonjour tomtom13100,cylfo,

un essai :

Sub test()
     Dim dossierPrincipal As String
     Dim dossierActuel As String
     Dim fichierGeoTxt As String
     Dim wb    As Workbook
     Dim ws    As Worksheet
     Dim premiereValeur As Double
     Dim derniereValeur As Double
     Dim resultatSoustraction As Double
     Dim title As String
     Dim dialog As Object

     ' Spécifie le dossier principal
     Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
     With dialog
          .title = "Sélectionner un dossier"
          .Show
          If .SelectedItems.Count > 0 Then
               choisirdossier = .SelectedItems(1)
          End If
     End With
     ' Vérifie si un dossier a été sélectionné
     If choisirdossier = "" Then
          MsgBox "Aucun dossier sélectionné. Le traitement est annulé."

     End If
     ' Boucle à travers les sous-dossiers du dossier principal

     s0 = choisirdossier & "\*23110800si11.geo"

     sn = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & s0 & """ /b /s ").StdOut.ReadAll, vbCrLf)
     If UBound(sn) < 0 Then
          MsgBox "Aucun fichier GeoTxt trouvé dans le dossier " & dossierActuel
     Else
          MsgBox Join(sn, vbLf), vbInformation, "Les " & UBound(sn) & " fichiers " & s0 'montrer tous ces fichiers (n'est pas nécessaire)
          For i = 0 To UBound(sn)
               If Len(sn(i)) > 0 Then
                    ' Ouvre le fichier Geo
                    Set wb = Workbooks.Open(sn(i))
                    Set ws = wb.Sheets(1)

                    ' Convertit la colonne A en nombre
                    ws.Columns("A:A").NumberFormat = "0"

                    ' Récupère la première et la dernière valeur
                    premiereValeur = ws.Cells(1, 1).Value
                    derniereValeur = ws.Cells(ws.Rows.Count, 1).End(xlUp).Value

                    ' Effectue la soustraction
                    resultatSoustraction = derniereValeur - premiereValeur

                    ' Ferme le fichier GeoTxt
                    wb.Close False

                    ' Affiche le résultat dans une fenêtre pop-up
                    MsgBox "Dans le dossier " & sn(i) & ", la soustraction est : " & resultatSoustraction
               End If
          Next
     End If
End Sub
Rechercher des sujets similaires à "probleme reconnaissance fichier txt"