Dim swApp               As Object
Dim Part_SW             As Object


Sub Dossiers4()


Dim P_recherche As New Collection
Dim P_recherche_Element As Variant
Dim i As String

Dim o_fileerror   As Long
Dim o_filewarning As Long

Dim o_chemin     As String 'impresion log
Dim o_WshShell   As Object 'impresion log
Dim o_intFic      As Integer 'impresion log


Dim o_Prop_MDE            As SldWorks.ModelDocExtension
Dim o_Prop                As SldWorks.CustomPropertyManager
Dim o_Prop_boolstatus     As Boolean
Dim o_Prop_Designation    As String
Dim o_Prop_longeur        As String
Dim o_Prop_Text           As String




Set swApp = Application.SldWorks





Set o_WshShell = CreateObject("WScript.Shell")
o_chemin = o_WshShell.SpecialFolders("MyDocuments")
o_chemin = o_chemin + "\MacroRecusiveSW.txt"

o_intFic = FreeFile 'impresion log
Open o_chemin For Output As o_intFic 'impresion log












RecursiveDir P_recherche, "C:\Users\lauzeral\Desktop\test dxf", "*.SLDPRT", True

i = 1
For Each P_recherche_Element In P_recherche ''boucle sur l'ensseble des fichier trouvé
    'MsgBox P_recherche_Element
    'i = i + 1
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set Part_SW = swApp.OpenDoc6(P_recherche_Element, swDocPART, swOpenDocOptions_Silent, "", o_fileerror, o_filewarning)
    Print #o_intFic, Now & " -- overture de " & Part_SW.GetTitle & "   erreur" & o_fileerror&; o_filewarning 'impresion log
    
    If o_fileerror = 0 Then
    
        'modification designation
        Set o_Prop_MDE = Part_SW.Extension
        Set o_Prop = o_Prop_MDE.CustomPropertyManager("")
        
        o_Prop_boolstatus = o_Prop.Get3("D", False, o_Prop_Text, o_Prop_Designation)
        Print #o_intFic, Now & " -- D=" & o_Prop_Designation 'impresion log"
        
        o_Prop_Designation = o_Prop_Designation & "New"
        o_Prop_boolstatus = o_Prop.Set("D", o_Prop_Designation)
    
        o_Prop_boolstatus = o_Prop.Get3("D", False, o_Prop_Text, o_Prop_Designation)
        Print #o_intFic, Now & " -- D=" & o_Prop_Designation 'impresion log"
        
        
        
        'ceer
        o_fileerror = o_Prop.Add2("Flag", swCustomInfoText, "31/05/2016")
        
        
        
        'lecture longueur (lié a la config)
        Set o_Prop_MDE = Part_SW.Extension
        Set o_Prop = o_Prop_MDE.CustomPropertyManager(swApp.GetActiveConfigurationName(P_recherche_Element))
        
        o_Prop_boolstatus = o_Prop.Get3("Lg", False, o_Prop_Text, o_Prop_longeur)
        Print #o_intFic, Now & " -- Lg=" & o_Prop_longeur 'impresion log"
        

        
        
      
        o_Prop_boolstatus = Part_SW.Save3(swSaveAsOptions_Silent, o_fileerror, o_filewarning)
        If o_Prop_boolstatus = False Or o_fileerror <> 0 Then
            Print #o_intFic, Now & " Problème d'enregistrement" 'impresion log"
        End If
        
        
        swApp.CloseDoc Part_SW.GetTitle
    
    End If
    
Next P_recherche_Element

Close #o_intFic 'impresion log

End Sub





Public Function RecursiveDir(O_recherche As Collection, _
                             o_chemin As String, _
                             O_specificite As String, _
                             O_Recursive As Boolean)

    Dim o_text     As String
    Dim o_SousChemin  As New Collection
    Dim o_SousChemin_element As Variant

    'Ajoute les fichier avec les specifcité dans le chemin à O_recherche
    o_chemin = Fonc_slache(o_chemin)
    o_text = Dir(o_chemin & O_specificite)
    Do While o_text <> vbNullString
        O_recherche.Add o_chemin & o_text
        o_text = Dir
    Loop

    If O_Recursive Then
        'on recheche les sous dossier
        o_text = Dir(o_chemin, vbDirectory)
        Do While o_text <> vbNullString
            If (o_text <> ".") And (o_text <> "..") Then
                    Dim toto As Integer
                    toto = GetAttr(o_chemin & o_text)
                If (GetAttr(o_chemin & o_text) And vbDirectory) <> 0 Then
                    o_SousChemin.Add o_text
                End If
            End If
            o_text = Dir
        Loop

        'on recheche dans les sous dossier (recherche qui recherchera dans les sous dossier)
        For Each o_SousChemin_element In o_SousChemin
            Call RecursiveDir(O_recherche, o_chemin & o_SousChemin_element, O_specificite, True)
        Next o_SousChemin_element
    End If

End Function


Public Function Fonc_slache(T_chemin As String) As String
    If Len(T_chemin) > 0 Then
        If Right(T_chemin, 1) = "\" Then
            Fonc_slache = T_chemin
        Else
            Fonc_slache = T_chemin & "\"
        End If
    End If
End Function