XL 2016 Ignorer un extension

[Don pépé]

Bonjour,
Je suis entrain de créer un petit module pour importer tous les modules d'un dossier nommé "Temp".
Mais je voudrais qu'il m'ignore une extension ".frx"

Alors j'en appel a vous car je ne sais comment mis prendre

    Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(xTemp) ' xTemp correstpond à ThisWorkbook.Path & "\Temp"
    For Each Fichier In dossier.Files
        Mdl = Mid(Fichier.Name, 1, InStrRev(Fichier.Name, ".") - 1) ' Nom du fichier sans l'extension
        'Vérifier si le fichier existe
        If VerifierExistenceModule(Mdl) = True Then
            'Si module existe on le supprime
            With ThisWorkbook.VBProject.VBComponents
                .Remove .Item(Mdl)
            End With
        End If
        'Install les modules trouver dans \temp
        ThisWorkbook.VBProject.VBComponents.Import Fichier
    Next

merci a vous

 

[Lone-wolf]

Bonjour Don pépé , le Forum

Pas sûr mais, enlève la ligne Mdl = Mid(Fichier.Name, 1, InStrRev(Fichier.Name, ".") - 1), puis

If Fichier.Name Like "*.frx" Then
Exit For
ElseIf VerifierExistenceModule(Fichier) = True Then
La suite du code

 

[Lone-wolf]

Re

Une autre solution

Option Explicit

Sub Importer_tous_les_Modules()
Dim List_Fichiers(10000, 1)
Dim Nom_Fichier As String
Dim Nb_Fichiers As Long
Dim chemin As String
Dim Modulo As String
Dim x As Long, tom

    chemin = "C:\Temp\"  ' à modifier
    Nom_Fichier = Dir$(chemin & "*.bas")

    Application.ScreenUpdating = False

    Do While Nom_Fichier <> ""
        List_Fichiers(Nb_Fichiers, 0) = Nom_Fichier
        Nom_Fichier = Dir$
        Nb_Fichiers = Nb_Fichiers + 1
    Loop
    Nb_Fichiers = 0

    With Sheets(2)
        While List_Fichiers(Nb_Fichiers, 0) <> tom
            .Range("a2").Offset(Nb_Fichiers, 0).Value = _
            List_Fichiers(Nb_Fichiers, 0)
            Nb_Fichiers = Nb_Fichiers + 1
            .Range("a:a").Columns.AutoFit
        Wend

        For x = 2 To .Range("a65536").End(xlUp).Row
            Modulo = chemin & .Cells(x, 1).Value
            ActiveWorkbook.VBProject.VBComponents.Import Modulo
        Next x
    End With

    Sheets(2).Range("a:a").Delete
End Sub

 

[Don pépé]

Salut Lone-wolf

merci pour ta réponse, mais la ligne Mdl = Mid(Fichier.Name, 1, InStrRev(Fichier.Name, ".") - 1),
me permet d'avoir mes fichiers sans l'extension donc je suis obliger de la garder pour vérifier si ils sont déjà installer si c'est le cas on les supprime pour installer les nouveau a jour.

il y aurais pas un moyen pour boucler les fichiers avec l'extension ".frx" pour pas qu'il ne les installes pas quand je fais : ThisWorkbook.VBProject.VBComponents.Import Fichier

edit : du genre un truc comme sa :

For l = 1 To Fichier.Name.Count
If Right(Fichier(l).Name, 1) <> "65000" _
And Not Fichier(l).Name = "*.frx" Then
ThisWorkbook.VBProject.VBComponents.Import Fichier(l).Name
End If
Next l

mais sa ne fonctionne pas erreur sur cet ligne : For l = 1 To Fichier.Name.Count

 

[Lone-wolf]

Re

Si j'ai bien compris ta demande, tu veux importer tous les fichiers .bas, n'est-ce pas? Donc

Option Explicit
Sub Test()
Dim xTemp As String, Dossier As Object, Fichier
 
    xTemp = ThisWorkbook.Path & "\Temp\"
    Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(xTemp)    ' xTemp correstpond à ThisWorkbook.Path & "\Temp"
 
    For Each Fichier In Dossier.Files
        If Fichier.Name Like "*.frx"  Or Fichier.Name Like "*.frm" Then
            Exit For
        ElseIf Fichier.Name Like "*.bas" Then
            ThisWorkbook.VBProject.VBComponents.Import Fichier
        End If
    Next
End Sub

Tous les fichiers .bas ont été importés.

 

[Don pépé]

pour le coup tu as vue juste c'est tout a fais sa merci a toi