XL 2019 VBA - Récupération de données de plusieurs fichiers avec chemins différents

[kulbank]

Salut à tous,

Je vous lis beaucoup mais ne publie que très peu. Merci pour cette mine d'informations qu'est ce forum! Je débute et bidouille mes macros avec plus ou moins de succès.

J'ai un souci... J'aimerais créer une base de données qui reprendrait des valeurs inscrites dans différents fichiers excel. Ces fichiers Excel sont ont toujours la même structure... Le souci vient du chemin pour extraire ces données. Le nom du projet est écris au début de chaque ligne du fichier Excel de la database (ci-dessous 7480_P).

Le souci que j'ai, c'est qu'une partie du chemin peut varier un peu. Le chiffre au début du nom peut varier soit, 7_Urbanisme, 8_Urbanisme, 9_Urbanisme, ... Donc Excel me signale une erreur car il ne trouve pas le fichier.

Exemple de chemins possible:
....................\7480_P\10_Urbanisme\Suivi de la circulation et du chantier.xlsm
....................\7480_P\9_Urbanisme\Suivi de la circulation et du chantier.xlsm
....................\7480_P\8_Urbanisme\Suivi de la circulation et du chantier.xlsm

Comment est-ce que je peux faire pour que Excel teste les chemins avec les nombres 5 à 15 à l'intérieur sans me retourner une erreur? Et comment faire pour que Excel aille ouvrir le fichier au bon endroit?
Si le fichier est introuvable, j'aimerais qu'un explorateur s'ouvre et me permette de le trouver manuellement. Et si le fichier n'existe pas, il faut que ça me crée le bordel dans les lignes.

J'ai aussi remarqué que si je n'ai pas le bon fichier d'ouvert, il passe sur un autre fichier excel et colle les infos dedans. Cela provient de la ligne, un peu cow-boys, "ActiveWindow.Close"

Je prends toute les infos qui peuvent aider, en particulier sur la gestion des erreurs (que je n'ai pas réussi à comprendre je crois).

Voici la partie du code.

Sub Macro3()


    NomData1 = ThisWorkbook.Name

    
    For i = 2 To 10 'faire un NBval à la place du 10
                    ' Ouverture du fichier Excel du dossier en fct de la liste
    Dim dossier
    dossier = Cells(i, 1)
    
    Dim chemin
    chemin = "V:\CirInf\" & dossier & "\10_Urbanisme\Suivi de la circulation et du chantier.xlsm"                         'C'EST ICI LE SOUCI!!!
    
' Ouverture du Excel source
    Dim NumPermis As String
On Error Resume Next
    NumPermis = Workbooks.Open(Filename:=chemin)
On Error GoTo 0
If Not ActiveWorkbook.Name = NomData1 Then


    Dim CirInf_Retour
    Dim Début_Travaux
    Dim Fin_Travaux
    Dim Conformité
    Dim Date_Permis_Construire
    Dim Date_Permis_Habiter

    CirInf_Retour = Range("E26")
    Début_Travaux = Range("F26")
    Fin_Travaux = Range("G26")
    Conformité = Range("H26")
    Date_Permis_Construire = Range("F42")
    Date_Permis_Habiter = Range("F44")
    
        ' Fermeture fichier source
    ActiveWindow.Close
    

    
        'Ecriture des données
    'Workbooks(NomData1 & "\").Activate
    Cells(i, 2).Select
    ActiveCell.Offset(0, 0).Range("A1").Value = CirInf_Retour
    ActiveCell.Offset(0, 0).Range("B1").Value = Début_Travaux
    ActiveCell.Offset(0, 0).Range("C1").Value = Fin_Travaux
    ActiveCell.Offset(0, 0).Range("D1").Value = Conformité
    ActiveCell.Offset(0, 0).Range("E1").Value = Date_Permis_Construire
    ActiveCell.Offset(0, 0).Range("F1").Value = Date_Permis_Habiter
    
    ActiveCell.Offset(0, 0).Range("B1").Select
        
        
        
        
        Else
        MsgBox ("Choisir chemin ou mettre erreur")

'Choix du dossier
        'Dim Var As Variant
        'Var = Application.GetOpenFilename("Fichiers (*.xls*),*.xls*")
        'Sheets("Suivi du dossier").Activate

'Pose un message d'erreurs
        'Dim messageErreur As String
       messageErreur = "Fichier Excel indisponible. Dossier " & dossier
        Cells(i, 2) = messageErreur

End If

Next

End Sub

 

[Jacky67]

Salut à tous,

Je vous lis beaucoup mais ne publie que très peu. Merci pour cette mine d'informations qu'est ce forum! Je débute et bidouille mes macros avec plus ou moins de succès.

J'ai un souci... J'aimerais créer une base de données qui reprendrait des valeurs inscrites dans différents fichiers excel. Ces fichiers Excel sont ont toujours la même structure... Le souci vient du chemin pour extraire ces données. Le nom du projet est écris au début de chaque ligne du fichier Excel de la database (ci-dessous 7480_P).

Le souci que j'ai, c'est qu'une partie du chemin peut varier un peu. Le chiffre au début du nom peut varier soit, 7_Urbanisme, 8_Urbanisme, 9_Urbanisme, ... Donc Excel me signale une erreur car il ne trouve pas le fichier.

Exemple de chemins possible:
....................\7480_P\10_Urbanisme\Suivi de la circulation et du chantier.xlsm
....................\7480_P\9_Urbanisme\Suivi de la circulation et du chantier.xlsm
....................\7480_P\8_Urbanisme\Suivi de la circulation et du chantier.xlsm

Comment est-ce que je peux faire pour que Excel teste les chemins avec les nombres 5 à 15 à l'intérieur sans me retourner une erreur? Et comment faire pour que Excel aille ouvrir le fichier au bon endroit?

Bonjour,
Une piste pour trouver le classeur s'il existe

Sub test()
    Dim Dossier$, Dossier1$, i&, j&, Chemincomplet$
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Dossier = Feuil1.Cells(i, 1) & "\"  '***Adapter nom de la feuille***
        For j = 5 To 15
            Dossier1 = j & "_Urbanisme"
            If Dir("V:\CirInf\" & Dossier & Dossier1 & "\Suivi de la circulation et du chantier.xlsm") <> "" Then
                Chemincomplet = "V:\CirInf\" & Dossier & Dossier1 & "\Suivi de la circulation et du chantier.xlsm"
                Exit For
            End If
        Next
    Next
    If Chemincomplet <> "" Then
        Workbooks.Open Chemincomplet
        'Suite de la macro avec ouverture du classeur
        '
    Else
        MsgBox "Classeur inexistant"
        'Suite de la macro si non trouvé
        '
    End If
End Sub

PS: Non testé, mais devrait faire
Bon courage