[déplacé VB6 - VBA] Methode execute appliquée à Filesearch

Question

Bonjour,
Je suis complètement autodidacte en EXCEL et VB aussi je sollicite votre indulgence si ma question est mal placée.
J'ai écrit une macro dans une feuille excel. Cette macro va lire des données dans des fichiers exel (il s'agit de poules de billard) et les cumule pour ensuite faire des classements et autres.
Tout fonctionne correctement sur mon PC.

Je copie l'ensembles des dossiers sur une clé USB pour aller chez un collègue qui doit utiliser cette appli. Je connecte ma clé USB et lui fait une démo, tout se passe bien.

Je copie l'ensemble de mes dossiers sur le bureau de son PC et là, ça ne marche plus. La méthode .Execute me retourne 0 alors que le fichier recherché est bien présent à l'endroit prévu !

En résumé, sur le PC du collègue, tout marche bien si on travaille à partir de ma clé USB et ça ne marche plus à partir du moment où on travaille à partir du bureau !!

Ci-dessous la macro bien que je ne crois pas qu'elle soit en cause ???


Sub CopieResultatsPoules()
'
' CopieResultatsPoules Macro
' Macro enregistrée le 08/08/2009 par J-P CHIQUET

'
    Dim Z As Integer
    Dim chem As String
    Dim Str As String
    Dim nom As String
    chem = ThisWorkbook.Path
    nom = ThisWorkbook.Name
    Application.ScreenUpdating = False
    For Z = 1 To Sheets.Count
    Worksheets(Z).unprotect Password:="llrb"
    Next Z
    Application.ScreenUpdating = True
        
Str = InputBox( _
             "INDIQUEZ ICI LE NOMBRE DE POULES DE QUALIFICATION A TRAITER :", "POULES DE QUALIFICATION", 0)
        Select Case Str
            Case " ", "", 0
                MsgBox ("LE NOMBRE DE POULES N'A PAS ETE RENTRE. ABANDON DE LA PROCEDURE")
                Exit Sub
            Case 1 To 4
                Set fs = Application.FileSearch
                With fs
                
                    .LookIn = chem
                    .Filename = "*N*Qualif*.xls"
                    If .Execute > 0 Then
                        'MsgBox "Il y a " & .FoundFiles.Count & _
                            " fichiers(s) trouvé(s)."
                        If .FoundFiles.Count = Str Then
                            For I = 1 To .FoundFiles.Count
                                Poule = .FoundFiles(I)
                                Workbooks.Open (Poule)
                                fichier = ActiveWorkbook.Name
                                Sheets("CLASSEMENT").Select
                                If I = 1 Then
                                    Range("X3:AG9").Select
                                    Selection.Copy
                                    Else
                                    Range("X4:AG9").Select
                                    Selection.Copy
                                End If
                                Windows(nom).Activate
                                If I = 1 Then
                                    Range("B7:K13").Select
                                ElseIf I = 2 Then
                                    Range("B15:K20").Select
                                ElseIf I = 3 Then
                                    Range("B22:K27").Select
                                ElseIf I = 4 Then
                                    Range("B29:K34").Select
                                ElseIf I = 5 Then
                                    Range("B36:K41").Select
                                ElseIf I = 6 Then
                                    Range("B43:K48").Select
                                End If
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                            Range("A1").Select
                            
                            Windows(fichier).Activate
                            fich = ActiveWorkbook.Name
                            Sheets("LISTE DES JOUEURS").Select
                            Range("C9:K14").Select
                            Selection.Copy
                            Windows(nom).Activate
                        
                            Sheets("POULES QUALIF").Select
                                If I = 1 Then
                                    Range("N9:V14").Select
                                ElseIf I = 2 Then
                                    Range("N15:V20").Select
                                ElseIf I = 3 Then
                                    Range("N21:V26").Select
                                ElseIf I = 4 Then
                                    Range("N27:V32").Select
                                ElseIf I = 5 Then
                                    Range("N33:V38").Select
                                ElseIf I = 6 Then
                                    Range("N39:V44").Select
                                End If
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                            Range("A1").Select
                            Workbooks(fich).Close SaveChanges:=False
                            Next I
                        Else
                            MsgBox ("NOMBRES DE POULES TROUVEES DIFFERENT DE CELUI INDIQUE. ABANDON DE LA PROCEDURE")
                            Exit Sub
                        End If
                    Else
                    MsgBox ("LES FICHIERS ATTENDUS N'ONT PAS ETE TROUVES")
                    Exit Sub
                    End If
                End With
        End Select
 
    If Str = 3 Then
        Call Classement_18_12
     ElseIf Str = 4 Then
        Call Classement_24_12
     End If
      
End Sub

Si quelqu'un a une idée et peut me donner une piste de recherche je l'en remercie par avance.



jpcR2

jpcR2 · Answer

Désolé pour la présentation de la macro. J'ai fait un copier coller et toutes les tabulations on été supprimées ce qui rend le pgm difficile à lire.

jpcR2

jpcR2 · Answer

Bonjour,
Aucune idée pour m'aider à résoudre ce problème ?


jpcR2

jpcR2 · Answer

Bonsoir,
Mon problème ne semble inspirer personne alors vous pouvez le clore.

jpcR2

us_30 · Answer

Bonsoir,

Le problème semble élémentaire, et il semble également bien décrit. Pourquoi ne pas vérifier les chemins ?... Par exemple, après :
chem = ThisWorkbook.Path
nom = ThisWorkbook.Name 
faire provisoirement un point d'arrêt pour vérifier que chem et nom sont bien ceux attendus... hum ?!... c'est forcément qlq chose de ce type que tu rencontres... (sinon, j'sais pas.)

Amicalement,
Us.

[déplacé VB6 -> VBA] Methode execute appliquée à Filesearch

4 réponses

Votre réponse

Discussions similaires