IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

[VBA-E]parcourir partour dans mon ordi pour trouver des avi


Sujet :

Macros et VBA Excel

  1. #1
    Membre régulier
    Profil pro
    Inscrit en
    Mars 2003
    Messages
    315
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Mars 2003
    Messages : 315
    Points : 105
    Points
    105
    Par défaut [VBA-E]parcourir partour dans mon ordi pour trouver des avi
    bonjour,
    j'Aimerais faire une liste de tout les videos que j'ai sur mon ordi (mpeg, avi.....).Étant paresseuse, je me suis dit que ça irait surement plus vite si je me faisait un petit programme recherchant ça a ma place. seulement, je n'ai qu'excel comme outil pour pouvoir coder..
    je me suis dit que je coderais une macro qui écrirait tous les nom des fichiers ayant comme extension tout les fichier video.
    je crois bien que excel marche avec vb....j'aimerais donc avoir des petits indice a savoir, comment faire pour faire une recherche partout
    merci
    shirya

  2. #2
    Expert éminent sénior


    Profil pro
    Inscrit en
    Juin 2003
    Messages
    14 008
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2003
    Messages : 14 008
    Points : 20 040
    Points
    20 040
    Par défaut
    tiens je me suis inspirer du code :

    http://support.microsoft.com/default...%3Bfr%3B467457

    pour créer cette macro :

    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
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
     
    Option Explicit
     
    Public Const MAX_PATH = 260
    Public Const INVALID_HANDLE_VALUE = -1
    Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
    Public Const FILE_ATTRIBUTE_SYSTEM = &H4
    Public Const FILE_ATTRIBUTE_READONLY = &H1
    Public Const FILE_ATTRIBUTE_NORMAL = &H80
    Public Const FILE_ATTRIBUTE_HIDDEN = &H2
    Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
    Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
    Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
    Public Const ERROR_NO_MORE_FILES = 18&
     
    'Struture utilisée par WIN32_FIND_DATA
    Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
    End Type
     
    'Struture utilisée par FindFirstFile
    Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
    End Type
     
    Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
    Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, lpFindFileData As _
    WIN32_FIND_DATA) As Long
    Declare Function FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long
    Declare Function GetLastError Lib "kernel32" () As Long
    'Détermine la longeur d'une chaine passée en argument.
    Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
    (ByVal lpString As String) As Long
     
    Sub Fnc_Recherche_Video(Rep As String)
    Dim WFD As WIN32_FIND_DATA
    Dim Handle_Recherche As Long
    Dim Suite_Recherche As Long
    Dim FileName As String
    Dim nb_car As String
    Dim Rep_Recherche As String
     
     
    Rep_Recherche = Rep & "*.*" 'Contient le répertoire de recherche
    'Initialisation de la recherche avec le chemin du répertoire à scruter.
    Handle_Recherche = FindFirstFile(Rep_Recherche, WFD)
    If Handle_Recherche = INVALID_HANDLE_VALUE Then
    'Cela signifie que la recherche ne peut se faire
    MsgBox ("Erreur dans le chemin de recherche")
    Exit Sub
    End If
     
    Suite_Recherche = 1
    Do While Suite_Recherche <> 0
    DoEvents
    'Retourne le nb de caractères précédent celui de fin de chaîne.
    nb_car = lstrlen(WFD.cFileName)
    'Extrait les caractères valides
    FileName = LCase(Left(WFD.cFileName, nb_car))
    'Teste si c'est un répertoire
    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
    'Vérifie si le nom du répertoire n'est pas le mère ou
    'l'enfant. (.. ou .)
    If (FileName <> "." And FileName <> "..") Then
    'Ajoute le répertoire à la liste de ceux scrutés.
    'ListDirectory.AddItem (Rep & FileName & "\")
    'Appel récursif pour recherche dans le nouveau
    'répertoire trouvé.
    Application.StatusBar = "Traite rep : " & Rep
    Call Fnc_Recherche_Video(Rep & FileName & "\")
    End If
    End If
    If FileName Like "*.avi" Or _
       FileName Like "*.mpg" Then
    'ListFile.AddItem (Rep & FileName)
    'Rajoute nom de fichier dans feuille excel courante cellule courante ( puis passe cellule en dessous)
     ActiveCell = Rep & FileName
     ActiveCell.Offset(1, 0).Activate
     Debug.Print "--------------------- > " & Rep & FileName
     
     
    End If
    'Recherche le fichier suivant.
    'Si Suite_Recherche vaut 0 le répertoire est vide et l'on
    'quitte la fonction.
    Suite_Recherche = FindNextFile(Handle_Recherche, WFD)
    Loop
    FindClose (Handle_Recherche)
    Application.StatusBar = False
    End Sub
    '
    '  Positionner le curseur sur la premiére cellule (en haut) devant acceuillir les noms de fichiers
    '
    Sub Test()
    Fnc_Recherche_Video "c:\"
    End Sub

  3. #3
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Maintenant, si c'est simplement en avoir la liste, tu peux faire ça :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Call Shell("cmd /c dir c:\*.avi /o /s > c:\ListeAvi.txt")
    /o les mets par ordre alpha, et /s visite tous les sous-répertoires

    Sous word, tu supprimes un saut de ligne sur deux, c'est plus lisible...

    A+

  4. #4
    Expert éminent sénior


    Profil pro
    Inscrit en
    Juin 2003
    Messages
    14 008
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2003
    Messages : 14 008
    Points : 20 040
    Points
    20 040
    Par défaut
    Citation Envoyé par ouskel'n'or
    Maintenant, si c'est simplement en avoir la liste, tu peux faire ça :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Call Shell("cmd /c dir c:\*.avi /o /s > c:\ListeAvi.txt")
    /o les mets par ordre alpha, et /s visite tous les sous-répertoires

    Sous word, tu supprimes un saut de ligne sur deux, c'est plus lisible...

    A+
    et les *.mpg....

  5. #5
    Membre chevronné
    Avatar de sovo
    Homme Profil pro
    Développeur Java
    Inscrit en
    Mars 2004
    Messages
    1 389
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Cameroun

    Informations professionnelles :
    Activité : Développeur Java
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mars 2004
    Messages : 1 389
    Points : 1 788
    Points
    1 788
    Par défaut
    Citation Envoyé par bbil
    et les *.mpg
    ca devrais donner ca :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Call Shell("cmd /c dir c:\*.mpg /o /s > c:\ListeMpg.txt")
    "Toute question a une reponse. Et chaque reponse est une nouvelle question." Albert EINSTEIN

    En cas de Question resolu, n'oubliez pas

  6. #6
    Membre régulier
    Profil pro
    Inscrit en
    Mars 2003
    Messages
    315
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Mars 2003
    Messages : 315
    Points : 105
    Points
    105
    Par défaut
    MARCI !ça marche
    désolée pour le délai....

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Macro Access] pb dans mon code pour lancer une macro Access
    Par Commodore dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 20/06/2007, 10h51
  2. Deux passages dans mon "execute" pour une seule soumission
    Par fabricew59 dans le forum Struts 1
    Réponses: 7
    Dernier message: 27/06/2006, 14h24
  3. [VBA-E] Excel Pb dans mon code
    Par flagfight dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 02/05/2006, 12h08
  4. [VBA][Débutant][export]erreurs dans mon code?
    Par Christophe93250 dans le forum Access
    Réponses: 4
    Dernier message: 06/01/2006, 19h52
  5. [VBA] Réagir aux clics dans mon TreeView
    Par Neilos dans le forum IHM
    Réponses: 2
    Dernier message: 16/06/2005, 09h03

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo