Fonction Dir

Bonjour,

Je suis sur ma première Macro VBA avec cependant des connaissances dans d'autres langages,

Le but de ma macro est très simple:

Lister le nom des 143 premiers fichiers *.AVI d'un dossier sélectionné

Avec préfixe DOOR_1, DOOR_2, DOOR_3, ou alors tous en fonction du contenu de la cellule Z17,

Si j'utilise le code suivant :

Sub dt_DOOR_1() 'sous programme date et time porte 1

i = 7

nf1 = Mid(Dir(repertoire & "\DOOR_1*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_1*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 21, 2) ' Uniquement door1 et .avi + renvoie date et heure + Mise en forme

Do While nf1 <> ""

Cells(i, 1) = nf1

nf1 = Dir ' suivant

i = i + 1

Loop

End Sub

[/code]

Excel me renvoi tous les noms de fichiers jusqu’à ce qu'il n'y en ai plus (Do While [b]nf1 <> "")

Comme je veux me limiter aux 143 premières valeurs, j'ai changé mon While par :

Do While i =< 143

Malheureusement avec cette modification Excel me renvoi Erreur d’exécution '5': Argument ou appel de procédure incorrect

et surligne la ligne

nf1 = Dir ' suivant

J'ai essayer d'utiliser For, avec le même résultat

 For i = 1 To 143
    Cells(i, 1) = nf1
    nf1 = Dir ' suivant
    i = i + 1
 Next

C'est comme s'il fallait que ma condition soit liée à Dir,

Est-ce que quelqu'un saurait m'expliquer ce qui cloche ?

Merci de votre aide,

Julien

Si besoin, voici le code en entier:

  Public repertoire As String
Sub dt_General()

  If Range("Z17") > 0 Then 'SI NUMERIQUE
       repertoire = InputBox("Enter the AVI file location")

    Select Case Range("Z17")
    Case Is = 1
        Call dt_DOOR_1
        Call dt_DOOR_2
        Call dt_DOOR_3
    Case Is = 2
        Call dt_DOOR_1
    Case Is = 3
        Call dt_DOOR_2
    Case Is = 4
        Call dt_DOOR_3
    End Select
    Else
MsgBox "Please select a door number"
 End If

End Sub

Sub dt_DOOR_1() 'sous programme date et time porte 1

 i = 7
    nf1 = Mid(Dir(repertoire & "\DOOR_1*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_1*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_1*.avi"), 21, 2) ' Uniquement door1 et .avi + renvoie date et heure + Mise en forme

 Do While nf1 <> ""
    Cells(i, 1) = nf1
    nf1 = Dir ' suivant
    i = i + 1
 Loop

End Sub

Sub dt_DOOR_2() 'sous programme date et time porte 2

 i = 7
    nf2 = Mid(Dir(repertoire & "\DOOR_2*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_2*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_2*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_2*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_2*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_2*.avi"), 21, 2) ' Uniquement door2 et .avi + renvoie date et heure + Mise en forme

 Do While nf2 <> ""
    Cells(i, 7) = nf2
    nf2 = Dir ' suivant
    i = i + 1
 Loop

End Sub

Sub dt_DOOR_3() 'sous programme date et time porte 3

 i = 7
    nf3 = Mid(Dir(repertoire & "\DOOR_3*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_3*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_3*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_3*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_3*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_3*.avi"), 21, 2) ' Uniquement door3 et .avi + renvoie date et heure + Mise en forme

 Do While i <= 143
    Cells(i, 13) = nf3
    nf3 = Dir ' suivant
    i = i + 1
 Loop

End Sub

SALUT

AVANT ça peu tu me dir pourquoi tu a spicifier auparvant le longueur de repertoire si vous demander de l'utilsateur d'entrer un

et si vous m'expliquer ou se trouve l'inf de " renvoie date et heure + Mise en forme"

autre chose vous pouver faire

extension =".avi"

nommedia2="DOOR_2" ect...

Bonsoir,

une proposition de correction de ton code, si j'ai bien compris ce que tu essayes de faire. à tester.

Public repertoire As String, i As Long
Sub dt_General()

  If Range("Z17") > 0 Then 'SI NUMERIQUE
      repertoire = InputBox("Enter the AVI file location")
      i = 7
    Select Case Range("Z17")
    Case Is = 1
        Call dt_DOOR(1)
        Call dt_DOOR(2)
        Call dt_DOOR(3)
    Case Is = 2
        Call dt_DOOR(1)
    Case Is = 3
        Call dt_DOOR(2)
    Case Is = 4
        Call dt_DOOR(3)
    End Select
    Else
MsgBox "Please select a door number"
 End If

End Sub

Sub dt_DOOR(n) 'sous programme date et time porte 1

    nf1 = Dir(repertoire & "\DOOR_" & n & "*.avi")

 Do While nf1 <> ""
    Cells(i, 1) = nf1
    nf1 = Dir()
   i = i + 1
   if i>143 then exit do 'si tu veux réellement arrêter à la ligne 143
 Loop

End Sub

Bonjour et merci AMIR et h2so4,

Le code que tu me propose h2so4, convient parfaitement après quelques ajustements,

Et c'est tellement plus propre que ce que j'avais fait ! Merci !

Je ne pensais pas pouvoir passer un argument dans l'appel de ma fonction en VBA,

Le code est donc ok, hormis un truc bizarre,

Les fichiers que je cherche à lister sont des fichiers avec ce type de nom:

DOOR_1_20150123-151317.avi

Numéro de porte, date (format anglais), heure sans mise en forme,

C'est pourquoi je fais cette mise en forme pour n'afficher que la date au format européen, et l'heure au format 15:13:17

    nf = Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 21, 2) ' Uniquement door1 et .avi + renvoie date et heure + Mise en forme

Avec le code actuel, quand j'exécute mon code, la première ligne est bien mise en forme en revanche toutes les suivantes ne le sont pas, tout le nom du fichier est inséré,

Si je remplace le nb = Dir dans la boucle While par nb = le code précédent, je recopie uniquement la première ligne,

Pour mon information personnel:

1. Au final tu as créé une autre boucle for pour faire fonctionner le Dir, je ne comprends pas trop pourquoi on ne peut pas le conditionner via un argument autre que Dir,

2. Je trouve l'importation assez longue des noms (15 secondes montre en main ), c'est parce que c'est du VBA, à cause de Dir ?

Car je n'ai que les 143*3 premiers noms de fichier à insérer et mettre en forme,

(Le dossier ou se trouvent mes fichiers, peut contenir jusqu'à 50 000 fichiers)

Merci de votre aide,

Julien

Voici le code actuel :

Public repertoire As String, i As Byte, c As Byte
Sub dt_General()

  If Range("Z17") > 0 Then 'vérification d'une entrée
     repertoire = InputBox("Enter the AVI file location")
    Select Case Range("Z17")
    Case Is = 1
        Call dt_DOOR(1, 1)
        Call dt_DOOR(2, 7)
        Call dt_DOOR(3, 13)
    Case Is = 2
        Call dt_DOOR(1, 1)
    Case Is = 3
        Call dt_DOOR(2, 7)
    Case Is = 4
        Call dt_DOOR(3, 13)
    End Select
    Else
MsgBox "Please select a door number"
 End If

End Sub

Sub dt_DOOR(n, c) 'sous programme date et time porte N
 i = 7
    nf = Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 21, 2) ' Uniquement door1 et .avi + renvoie date et heure + Mise en forme

 Do While nf <> ""
    Cells(i, c) = nf
    nf = Dir
   i = i + 1
   If i >= 150 Then Exit Do 'N'importer que les lignes 143 premiers fichiers
Loop

End Sub

Bonjour,

 nf = Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 14, 2) + "/" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 12, 2) + "/" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 10, 2) + " - " + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 17, 2) + ":" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 19, 2) + ":" + Mid(Dir(repertoire & "\DOOR_" & n & "*.avi"), 21, 2) ' Uniquement door1 et .avi + renvoie date et heure + Mise en forme

dans cette instruction tu fais 6 fois appel à la fonction dir -> pas très performant.

proposition de correction

Public repertoire As String, i As Byte, c As Byte
Sub dt_General()
    If Range("Z17") > 0 Then    'vérification d'une entrée
        Set fd = Application.FileDialog(msoFileDialogFolderPicker)
        With fd
            .Title = "Sélectionner répertoire"
            .Filters.Clear
            .AllowMultiSelect = False
            If .Show = -1 Then
                repertoire = .SelectedItems(1)
                Select Case Range("Z17")
                Case Is = 1
                    Call dt_DOOR(1, 1)
                    Call dt_DOOR(2, 7)
                    Call dt_DOOR(3, 13)
                Case Is = 2
                    Call dt_DOOR(1, 1)
                Case Is = 3
                    Call dt_DOOR(2, 7)
                Case Is = 4
                    Call dt_DOOR(3, 13)
                End Select
            End If
        End With
    Else
        MsgBox "Please select a door number"

    End If
End Sub

Sub dt_DOOR(n, c)    'sous programme date et time porte N
    i = 7
    nf = Dir(repertoire & "\DOOR_" & n & "*.avi")

    Do While nf <> ""
        Cells(i, c) = Mid(nf, 14, 2) + "/" + Mid(nf, 12, 2) + "/" + Mid(nf, 10, 2) + " - " + Mid(nf, 17, 2) + ":" + Mid(nf, 19, 2) + ":" + Mid(nf, 21, 2)  ' Uniquement door1 et .avi + renvoie date et heure + Mise en forme
        nf = Dir()
        i = i + 1
        If i >= 150 Then Exit Do    'N'importer que les lignes 143 premiers fichiers
    Loop
End Sub

Hello h2so4,

C'est parfait ! La sélection du répertoire est même plus "propre"

J'ai tendance à penser que c'est toujours un peu long (>10 sec) mais soit

PS : J'ai vraiment eu l'impression de parler comme un extraterrestre, et de surtout d'avoir des demandes d'extraterrestes, même si tu dois avoir l'habitude avec certains membres