Windows 7 - Débogage

[jorisphi]

Bonjour à tous,

J'ai récupéré les codes d'un forumeur XLD, mais je ne me rappelle plus de qui
S'il se reconnait, Grand Merci à lui

Voici mon problème :

Je travaille avec Windows XP et MS office Excel 2003 et tout fonctionne correctement
Par contre avec Windows 7 et MS Excel 2003, J'ai un débogage sur la ligne suivante :
For Each sousdoss In fs.getfolder(Dossier).subfolders

Quelqu'un parmi vous pourrait-il m'aider et me dire quelle modification à apporter à mon code ?
Merci d'avance
Cordialement
Jorisphi

 

[Compte Supprimé 979]

Re : Windows 7 - Débogage

Bonjour Jorisphi

Je ne peux pas t'apporter de solution, mais un élément de réponse

Avec Seven, c'est un problème de droits d'accès
Tu peux essayer comme ça

Sub ListeArborescence(Dossier As String)
Dim fs, sousdoss
    Set fs = CreateObject("Scripting.FileSystemObject")
    [B][COLOR=blue]On Error Resume Next[/COLOR][/B]
    For Each sousdoss In fs.getfolder(Dossier).subfolders
        ReDim Preserve ListeDoss(1 To UBound(ListeDoss) + 1)
        ListeDoss(UBound(ListeDoss)) = sousdoss.Path
        ListeArborescence sousdoss.Path
    Next sousdoss
    [B][COLOR=blue]On Error GoTo 0
[/COLOR][/B]    Set fs = Nothing
End Sub

A+

 

[jorisphi]

Re : Windows 7 - Débogage

Bonjour BrunoM45

Je prend note ce jour de ton post (absent 2 jours)
Merci pour ta réponse
Je vais tester sur le PC de l'utilisateur et je te tiendrai au courant

Encore Grand MERCI
Cordialment
Jorisphi

Bonjour Jorisphi

Je ne peux pas t'apporter de solution, mais un élément de réponse

Avec Seven, c'est un problème de droits d'accès
Tu peux essayer comme ça

Sub ListeArborescence(Dossier As String)
Dim fs, sousdoss
    Set fs = CreateObject("Scripting.FileSystemObject")
    [B][COLOR=blue]On Error Resume Next[/COLOR][/B]
    For Each sousdoss In fs.getfolder(Dossier).subfolders
        ReDim Preserve ListeDoss(1 To UBound(ListeDoss) + 1)
        ListeDoss(UBound(ListeDoss)) = sousdoss.Path
        ListeArborescence sousdoss.Path
    Next sousdoss
    [B][COLOR=blue]On Error GoTo 0
[/COLOR][/B]    Set fs = Nothing
End Sub

A+