Lister les fichiers qui utilisent VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

30/05/2013, 22h03
neodeco

Lister les fichiers qui utilisent VBA

Bonjour à tous,

Voilà mon problème, j'aimerai faire une liste de mes fichiers excel mais surtout savoir ceux qui utilise VBA

Faire une liste de mes fichiers je sais faire.

Ce que je n'arrive pas à faire ou à trouver c'est :
Comment savoir si les fichiers excel utilisent du VBA ou pas.

Cela doit être possible puisque, lorsqu'on lance un fichier qui utilise VBA il nous demande si on veut activer les macros ou pas.

Merci d'avance à ceux qui pourront m'aider.
30/05/2013, 22h23
Invité

Bonsoir neodeco

En ouvrant 1 à 1 les fichiers, tu peux savoir effectivement ... mais alors ça risque d'être lonnnnnggggg :?
30/05/2013, 23h21
neodeco

C'est un coup de main que je demande, si vous ne savez pas ou si ce n'est pas faisable dîtes le, mais évitez les réponses de ce genre.

Merci.
30/05/2013, 23h41
Invité

Re,

Noob sur ce forum avec 4 messages et voilà ta réponse ...:mouarf3:

Je te dis simplement que c'est faisable mais en ouvrant les fichiers, pas autrement ...

Tu iras loin comme ça :bravo:

A tchao
31/05/2013, 00h15
neodeco

Je suis peut être un noob sur ce forum mais bon ouvrir les fichiers un à un je sais le faire, j'ai pas besoin de venir poser une question sur un forum pour faire ça.
Ta façon de répondre ne me plait pas du tout, voilà.

Il suffit de dire que ce n'est pas faisable et le sujet était clos.

C'est pas avec des réponses comme ça que l'on avance.

Ciao

Il y a une solution envisageable.

Une fois que tu as listé tes fichiers, tu peux tester le contenu des modules VB qu'ils contiennent :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Function VerifMacro(byval Fichier as string) as boolean Dim MODULE As Object Dim classeur As Workbook Dim macroVB As Boolean macroVB = False Set classeur = Workbooks.Open(Fichier) For Each MODULE In classeur.VBProject.VBComponents If MODULE.CodeModule.CountOfLines <> 0 Then macroVB=true Exit For End If Next classeur.Close set classeur = Nothing VerifMacro=MacroVB End Function
Ce code regarde tout les modules VB (y compris les feuilles, thisworkbook et les userforms) du fichier et compte les lignes. Si il y a une seule ligne de code dans le fichier, alors il retourne qu'il comporte une macro.

Bonsoir,

Je suppose que c'est le mauvais temps qui échauffe les esprits ;-)

Voici une piste pour savoir si le classeur contient ou non un projet VBA (j'ai pas testé sur des classeurs volumineux).
Il suffit de l'ouvrir en mode binaire et de rechercher si une certaine chaîne existe, en l'occurrence, cette chaîne >Name="VBAProject"<.
Comme tu dis savoir comment faire la liste des fichiers contenus dans le dossier, je n'ai pas mis cette partie de code :
Code:

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 Sub Savoir_Si_VBA() Dim Classeur As String Dim Chaine As String 'chemin du classeur, à adapter Classeur = "D:\Test\Classeur1.xls" 'ouvre le classeur en mode binaire Open Classeur For Binary As #1 'récupère tout le contenu en une seule fois Chaine = Space(LOF(1)) Get #1, , Chaine Close #1 'recherhe la chaîne 'Name="VBAProject" et indique si trouvé ou non If InStr(Chaine, "Name=""VBAProject""") Then MsgBox "Le classeur " & Dir(Classeur) & " contient un projet VBA !" Else MsgBox "Le classeur " & Dir(Classeur) & " ne contient pas de projet VBA !" End If End Sub
Hervé.

31/05/2013, 21h23
NVCfrm
bonsoir,

Bonsoir Theze ,
la solution avec Open en binary est bonne sauf qu'elle n'est pas recommandée.
Je cite une parie de la rubrique aide: "Ce type d'ouverture pourrait compromettre l'intégrité du fichier et endommager ce dernier"
La chaleur... sans aucun doute.

Workbook.HasVBProject permet de savoir si le classeur est un projet VBA
il est préférable d'ouvrir le classeur avec GetObject
Code:

1 2 3 4 5 6 7 8 9 10 Dim wb As Workbook ..... .... Set wb = GetObject("") If wb.HasVBProject Then .... wb.Close False ...... .... Set wb = Nothing
31/05/2013, 21h29
Theze

Bonsoir Ousmane,

Merci pour l'info, j'en prend bonne note ! C'est une piste qui m'est venue et je n'ai pas cherché plus loin car après quelques tests les résultats étaient probants.

Hervé.
31/05/2013, 22h43
neodeco

Merci pour votre aide, je vais tester ça.
31/05/2013, 23h47
Invité

Bonjour à tous

Comme je le disais au début du fil :roll:
Ce n'est possible qu'en ouvrant les fichiers 1 à 1 :ccool:

Et comme je le disais "gentiment" cela peut être loooonnngggg :cry:
Mais bon ....

Bonjour,

Après plusieurs tests en lecture binaire (j'ai ouvert 100 fois chaque classeur, une dizaine) aucun d'eux n'a été corrompu.
Je pense qu'il y a autant de chance de corrompre un classeur avec une lecture binaire qu'il y en a avec les bidouilles hasardeuses qu'on fait avec VBA qui plante Excel et rend de temps en temps un classeur irrécupérable mais comme "Prudence est mère de sûreté", je conseille neodeco de faire une copie du dossier contenant les fichiers et de faire la lecture dans ce dernier.
Ici un code pour faciliter le choix du dossier. Les classeurs contenant des macros sont listés en colonne A :

Code:

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
 
Sub Savoir_Si_VBA()
 
    Dim TblFichiers() As String
    Dim Tbl() As String
    Dim Dossier As Variant
    Dim Chaine As String
    Dim I As Long
    Dim J As Long
 
    'récupère le chemin du dossier
    Dossier = RecupDossier
 
    'si pas de choix de dossier, fin
    If Dossier = False Then Exit Sub
 
    'récupère les fichiers du dossier dans le tableau
    TblFichiers = Fichiers(Dossier)
 
    'si tableau vide
    On Error GoTo Fin
 
    For I = 1 To UBound(TblFichiers)
 
       'ouvre le classeur en mode binaire
       Open TblFichiers(I) For Binary As #1
 
           'récupère tout le contenu en une seule fois
            Chaine = Space(LOF(1))
            Get #1, , Chaine
 
            'recherhe la chaîne 'Name="VBAProject" et
            'stocke le nom du classeur un tableau si trouvée
            If InStr(Chaine, "Name=""VBAProject""") Then
 
                J = J + 1
                ReDim Preserve Tbl(1 To J)
                Tbl(J) = Dir(TblFichiers(I))
 
            End If
 
       Close #1
 
    Next I
 
    'indique en colonne A les classeurs contenant des macros
    For I = 1 To UBound(Tbl)
 
 
        Cells(I + L, 1) = Tbl(I)
 
    Next I
 
Fin:
 
End Sub
 
Function RecupDossier() As Variant
 
    With Application.FileDialog(4)
 
        .Show
 
        On Error Resume Next 'si annuler
 
        RecupDossier = .SelectedItems(1)
 
        If Err.Number <> 0 Then RecupDossier = False
 
    End With
 
End Function
 
Function Fichiers(ByVal Chemin As String) As String()
 
    Dim Tbl() As String
    Dim Fichier As String
    Dim I As Long
 
    'complète le chemin le cas échéant
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
 
    'boucle dans le dossier
    Fichier = Dir(Chemin)
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve Tbl(1 To I)
 
        Tbl(I) = Chemin & Fichier
 
        Fichier = Dir()
 
    Loop
 
    Fichiers = Tbl()
 
End Function

Hervé.

01/06/2013, 11h10
NVCfrm

bonjour à tous,

Il m'a paru intéressant de tester ta solution Open, qui me séduisait depuis le début.
Pour preuve que j'ai testé, la ligne 50 contient un bug.
J'ai crée un nouveau dossier, copier quelques 5 fichiers d'extensions diffferentes .xlsm, .xlsb, .xlsx, .csv.
Certains contiennent des macros, et d'autres non.
Les fichiers sont ouverts et fermés sans chargement du tableau Tbl.
Instr à ma grande désolation ne trouve que dalle.

Vu qu'il n'y a pas de manipulation de modification sur le fichier tu as raison sur le risque de compromission qui est probablement nul.

Mon avis: j'opterais pour GetObject et le test HasVBProject pour un test direct.
01/06/2013, 13h17
Invité

Bonjour le fil

Le code de Theze marche très bien pour des fichiers ".xls" mais pas pour les versions ultérieure ;)
01/06/2013, 13h40
NVCfrm

bonjour Bruno,
merci pour l'info.
j'aurais dû y penser.
01/06/2013, 14h14
Philippe Tulliez

Bonjour à tous,
A défaut de trouver mieux pour l'instant et supposant que si le suffixe d'un classeur est XLSM, il y a de fortes chances qu'il contienne du code VBA.
Pour les versions au delà de 2003, il suffit de modifier la ligne 34 du code proposé par Theze qui fonctionne parfaitement bien et est très rapide.

Code:

If InStr(Chaine, "Name=""VBAProject""") Or LCase(Right(TblFichiers(I), 4)) = "xlsm" Then ....

Bonjour tout le monde,

Citation:

Pour preuve que j'ai testé, la ligne 50 contient un bug
Code:

1 2 Cells(I + L, 1) = Tbl(I)
NVCfrm, il y a un bug tout simplement parce que j'ai oublié d'ôter la variable "L" qui m'a servi à la boucle des 100 ouvertures, désolé pour cet oubli :o(

J'ai Excel 2007 mais j'enregistre tous mes classeurs sous .xls et je n'ai effectué que des tests sur ce type de classeur. Je vais voir pour les autre types.
Notons tout de même que les fichiers .xlsx et .csv n'ont pas besoin d'être testés puisque par définition ils ne peuvent contenir de projet VB, je vais tester sur les autres.

Hervé.

Re,

Bon, j'ai effectuer des tests sur les .xlsb et .xlsm (pour ces derniers la chaîne recherchée est "vbaProject.binPK") et j'ai adapter mon code, si vous pouvez tester de votre coté et donner vos conclusions, chez moi, ils sont bien dans la liste, NVCfrm tu dois avoir encore ton dossier test, dis nous le résultat :
Code:

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 Sub Savoir_Si_VBA() Dim TblFichiers() As String Dim Tbl() As String Dim Dossier As Variant Dim Chaine As String Dim I As Long Dim J As Long 'récupère le chemin du dossier Dossier = RecupDossier 'si pas de choix de dossier, fin If Dossier = False Then Exit Sub 'récupère les fichiers du dossier dans le tableau TblFichiers = Fichiers(Dossier) 'si tableau vide On Error GoTo Fin For I = 1 To UBound(TblFichiers) 'ouvre le classeur en mode binaire Open TblFichiers(I) For Binary As #1 'récupère tout le contenu en une seule fois Chaine = Space(LOF(1)) Get #1, , Chaine 'recherhe la chaîne 'Name="VBAProject" et 'stocke le nom du classeur un tableau si trouvée If InStr(Chaine, "vbaProject.binPK") Or InStr(Chaine, "Name=""VBAProject""") Then J = J + 1 ReDim Preserve Tbl(1 To J) Tbl(J) = Dir(TblFichiers(I)) End If Close #1 Next I 'indique en colonne A les classeurs contenant des macros For I = 1 To UBound(Tbl) Cells(I, 1) = Tbl(I) Next I Fin: End Sub
Hervé.

01/06/2013, 16h34
NVCfrm

bonjour Hervé,

Quelle originalité!

je confirmes que ça marche!
01/06/2013, 16h47
Theze

Hello NVCfrm, merci d'avoir testé ;-)

Hervé.
02/06/2013, 09h06
neodeco

Ça marche nickel, un grand MERCI.

Voir 40 message(s) de cette discussion en une page