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 SubMerci 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