Optention d chemin d'acces des fichier d'un dossier

bonjour,

j'ai une macro qui permet d'extraire les données d'un fichier .bin l'objectif serais de repeater cette macro automatiquement pour tout les fichier d'un dossier que l'utilisateur choisit . voici la procedure pour selectioné le fichier

Dim ws As Worksheet

Dim WorksheetExists As Boolean

Dim myHeader As T_HEADER

Dim myRecord1Minute As T_RECORD_1MIN

Dim myRecord1Heure As T_RECORD_1HEURE

' --- Ouverture du fichier d'historique à extraire

'-------------------------------------------------

strFullPathFile = Application.GetOpenFilename(Title:="Please choose a historic file to open", FileFilter:="Historic file (*.bin*), *.bin", MultiSelect:=False)

If strFullPathFile = False Then

MsgBox "No file selected.", vbExclamation, "Sorry!"

Exit Sub

Else

' --- Extraire le nom du fichier selectionné

' ------------------------------------------

strFile = strFullPathFile

strFile = StrReverse(strFile)

Pos = InStr(1, strFile, "\", 1)

strFile = Left(strFile, Pos - 1)

strFile = StrReverse(strFile)

Pos = InStr(1, strFile, ".", 1)

Extention = Right(strFile, Len(strFile) - Pos)

NomFichierSansExtension = Left(strFile, Pos - 1)

bonjour,

une proposition

 With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Selectionnez le répertoire"
        If .Show = True Then
            fullpath = .SelectedItems(1)
        Else
            MsgBox "pas de répertoire sélectionné"
            Exit Sub
        End If
    End With
    strfile = Dir(fullpath & "\*.bin")
    While strfile <> ""
        ' --- Extraire le nom du fichier selectionné
        ' ------------------------------------------
        Pos = InStr(1, strfile, ".", 1)
        Extention = Right(strfile, Len(strfile) - Pos)
        NomFichierSansExtension = Left(strfile, Pos - 1)
        '(...)
        strfile = Dir()
    Wend

Bonjour

Tout d'abord merci pour ton retour @h2s04 la selection du dossier marche bien mais le problem est que lorsque j'arrive a se niveau dans mon programe

strfile = strFullPathFile

strfile = StrReverse(strfile)

Pos = InStr(1, strfile, "\", 1)

-> strfile = Left(strfile, Pos - 1)

strfile = StrReverse(strfile)

Pos = InStr(1, strfile, ".", 1)

Extention = Right(strfile, Len(strfile) - Pos)

NomFichierSansExtension = Left(strfile, Pos - 1)

PLus présisement strfile ne prend pas la valeur a se niveau la

strfile = Dir(fullpath & "\*.bin")

merci d'avence

Bonjour,

c'est bien pour éviter ce bug que j'ai supprimé des lignes dans ton code.

la fonction dir ne renvoie que le nom du fichier (et pas son chemin d'accès complet).

Serait t'il possible d'obtenir le chemin d'acces complet dans une variable car je m'en sert plus tard dans la macro

'--------------------------------------------------------

' Extraction de l'historique du fichier HISTXX.bin

'--------------------------------------------------------

Sub Extract_histo()

Dim ws As Worksheet

Dim WorksheetExists As Boolean

Dim myHeader As T_HEADER

Dim myRecord1Minute As T_RECORD_1MIN

Dim myRecord1Heure As T_RECORD_1HEURE

' --- Ouverture du fichier d'historique à extraire

'-------------------------------------------------

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False

.Title = "Selectionnez le répertoire"

If .Show = True Then

FullPath = .SelectedItems(1)

Else

MsgBox "pas de répertoire sélectionné"

Exit Sub

End If

End With

strfile = Dir(FullPath & "\*.bin")

While strfile <> ""

' --- Extraire le nom du fichier selectionné

' ------------------------------------------

Pos = InStr(1, strfile, ".", 1)

Extention = Right(strfile, Len(strfile) - Pos)

NomFichierSansExtension = Left(strfile, Pos - 1)

'(...)

strfile = Dir()

' --- Extraire le nom du fichier selectionné

' ------------------------------------------

Pos = InStr(1, strfile, "\", 1)

'strfile = Left(strfile, Pos - 1)

'strfile = StrReverse(strfile)

Pos = InStr(1, strfile, ".", 1)

Extention = Right(strfile, Len(strfile) - Pos)

NomFichierSansExtension = Left(strfile, Pos - 1)

' ---- Créér un nouvel onglet avec le nom du fichier

' --------------------------------------------------

NomOnglet = NomFichierSansExtension

i = 0

Do

WorksheetExists = False

For Each ws In ThisWorkbook.Sheets

If ws.name = NomOnglet Then

NomOnglet = NomFichierSansExtension + "_" + CStr(i)

WorksheetExists = True

i = i + 1

End If

Next ws

Loop While WorksheetExists = True

Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

ws.name = NomOnglet

' --- Extraction des données du fichier

'--------------------------------------

FileHandler = FreeFile

Open strfile For Binary Access Read As FileHandler

Length = LOF(FileHandler)

' --- Extrait le header du fichier binaire

'-----------------------------------------

If (Length < 2048) Then

MsgBox "This file is not completed !", vbExclamation, "Sorry!"

Close FileHandler

Exit Sub

End If

Get #1, , myHeader

afficheHeader myHeader

' --- Ouverture de la barre de progression

'-----------------------------------------

BarrePrg.Show 0

BarrePrg.StartUpPosition = 1 'CenterScreen

BarrePrg.BarrePrg_Progress Loc(FileHandler), LOF(FileHandler)

' --- Extrait les mesures du fichier binaire

'-------------------------------------------

Seek #FileHandler, &H801

While ((LOF(FileHandler) - Loc(FileHandler)) >= (224 * 60))

Get #1, , myRecord1Heure

BarrePrg.BarrePrg_Progress Loc(FileHandler), LOF(FileHandler)

afficheRecord1H myHeader, myRecord1Heure

Wend

While ((LOF(FileHandler) - Loc(FileHandler)) >= 224)

Get #1, , myRecord1Minute

BarrePrg.BarrePrg_Progress Loc(FileHandler), LOF(FileHandler)

afficheRecord myHeader, myRecord1Minute

Wend

' --- Mise en forme final

'------------------------------------

' Centrage de toutes les cellules

Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).HorizontalAlignment = xlCenter

'Figer les volets ligne 2 colonne 2

Range("B3").Select

ActiveWindow.FreezePanes = True

' --- Fermeture de la barre de progression

'-----------------------------------------

Unload BarrePrg

MsgBox "Extraction completed", vbApplicationModal, "Extract Histo"

Close FileHandler

Wend

End Sub

bonjour,

remplace cette instruction

Open strfile For Binary Access Read As FileHandler

par celle-ci

Open fullpath & "\" & strfile For Binary Access Read As FileHandler

Merci becoups !!!! ca marche