Verifier la date d'un fichier par rapport à un autre fichier

Bonjour,

Je suis débutant en VBA et je souhaite faire une macro qui vérifie un fichier à une date donnée ( rempli à la main) par rapport à un fichier qu'on extrait sur une autre source. En fait le but c'est de savoir si les données dans 211119_source qu'on a exporté sont bien à la bonne date dans le fichier test_date cellule A1et pas à une autre date.

Ci-joint le code que j'ai essayé de faire, si vous avez des indications à me donner, je suis preneur.

Option Explicit

Sub controle_date_import()

Dim wb As Workbook
Dim toute_source As Worksheet
Dim Input_EOS As Workbook
Dim Controle_date As Worksheet
Dim date_reporting As String
Dim j As Long
Dim path As String
Dim nom_fic As String
Dim fichier As String

Set wb = ThisWorkbook
Set toute_source = wb.Sheets("source")

date_reporting = toute_source.Cells(1, 1)
path = toute_source.Cells(18, 1)
nom_fic = Dir(path)
fichier = toute_source.Cells(18, 2)

Do While nom_fic <> ""
Workbooks.Open path & fichier
Set Input_EOS = Application.ActiveWorkbook

'For i = 2 To Input_EOS.Sheets(1).Cells(Rows.Count).End(xlUp).Row
For j = 19 To toute_source.Cells(Rows.Count).End(xlUp).Row

    If Input_EOS.Sheets(1).Cells(2, 6) <> toute_source.Cells(j, 1) Or Input_EOS.Sheets(1).Cells(2, 6) <> toute_source.Cells(j + 1, 1) Or Input_EOS.Sheets(1).Cells(2, 6) <> toute_source.Cells(j + 2, 1) Then
        MsgBox ("Ce fichier n'est à la bonne date de reporting")
    End If

Next
nom_fic = Dir()
Loop

Bonjour

C'est un peu difficile de vous répondre sans avoir le fichier avec la feuille Source mentionnée dans votre code

Autres questions :
- si le fichier n'est pas à la bonne date, on peut arrêter le code plutot que de continuer le contrôle ?
- votre code se trouve bien dans le fichier contenant la feuille Source ?

Cordialement

Ah oui, veuillez m'excuser, je vais reformuler ma demande :

Je souhaite vérifier dans mon fichier pilotage (test-date.xlsm), si le fichier externe 211119_VL.xlsx que j'ai exporté à des lignes qui sont à la bonne date que mon fichier pilotage, j'ai fait une petite macro mais je n'arrive pas à comprendre pourquoi :

- Celui ci ne passe pas sur ma condition de vérifier si les valeurs dans 211119 correspondent bien aux date dans pilotage ( 19/11/2021 ou 20/11/2021 ou 21/11/2021)

-La boucle tourne sur un autre fichier dont le nom de la feuille n'est pas égale aux nom mentionné en B18

Option Explicit

Sub controle_date_import()

Dim wb As Workbook
Dim toute_source As Worksheet
Dim Input_EOS As Workbook
Dim Controle_date As Worksheet
Dim date_reporting As Date
Dim j As Long
Dim path_EOS As String
Dim fic_EOS As String
Dim fichier1 As String
Dim fin As Boolean

Set wb = ThisWorkbook
Set toute_source = wb.Sheets("source")

date_reporting = toute_source.Cells(1, 1)
path_EOS = toute_source.Cells(18, 1)
fic_EOS = Dir(path_EOS)
fichier1 = toute_source.Cells(18, 2)

' Controle Date fichier EOS
Do While fic_EOS <> ""

    If fichier1 <> toute_source.Cells(18, 2) Then fin = True
    Workbooks.Open path_EOS & fichier1
    Set Input_EOS = Application.ActiveWorkbook

For i = 2 To Input_EOS.Sheets(1).Cells(Rows.Count).End(xlUp).Row
For j = 19 To toute_source.Cells(Rows.Count).End(xlUp).Row

            If Input_EOS.Sheets(1).Cells(i, 6).Value = toute_source.Cells(j, 1) Or Input_EOS.Sheets(1).Cells(i, 6).Value = toute_source.Cells(j + 1, 1) Or Input_EOS.Sheets(1).Cells(i, 6).Text = toute_source.Cells(j + 2, 1) Then
                toute_source.Cells(18, 3) = "OK"
            ElseIf Input_EOS.Sheets(1).Cells(i, 6).Value < toute_source.Cells(j, 1) Then GoTo erreur
            End If
erreur:
            toute_source.Cells(18, 3) = "Pas OK"
            Exit sub
Next
Next
    End if
        Input_EOS.Close savechanges:=False
        fichier1 = Dir(fic_EOS)
Loop

End Sub

C'est un peu compliqué.
Déjà ici on a deux codes différents et quand j'ouvre votre fichier Test_date, il y a encore un code différent

Lequel est celui à prendre en considération ?

Plutot le code mis dans le forum, j'ai oublié de changer l'ancien. Veuillez m'excuser.

Plutot le code mis dans le forum,

lequel ? il y en a deux

Edit : autres questions,

1. pourquoi dans la boucle J commencez-vous sur la ligne 19 alors qu'à cet endroit vous mettez un lien B:\.....
2. qu'avez-vous comme info en B20 et B21 ?
3. A quoi sert la variable Date_reporting ? Vous ne l'utilisez pas dans le code

Si j'ai bien compris, dans votre fichier test-Date, vous mettez des dates en A21 à A23 et vous contrôlez que ces dates sont présentes dans le fichier 211119_VL en colonne F.

J'ai rectifié la feuille excel, les dates se trouve à partir de A19 à A21 et voici le nouveau fichier mis à jour.

Dans B20 et B21, ils devait avoir d'autre lien menant à d'autres dossiers similaire , mais je voulais faire un test avec celui ci, si ça fonctionne.

Option Explicit

Sub controle_date_import()

Dim wb As Workbook
Dim toute_source As Worksheet
Dim Input_EOS As Workbook
Dim Controle_date As Worksheet
Dim date_reporting As Date
Dim j As Long
Dim path_EOS As String
Dim fic_EOS As String
Dim fichier1 As String
Dim fin As Boolean

Set wb = ThisWorkbook
Set toute_source = wb.Sheets("source")

date_reporting = toute_source.Cells(1, 1)
path_EOS = toute_source.Cells(18, 1)
fic_EOS = Dir(path_EOS)
fichier1 = toute_source.Cells(18, 2)

' Controle Date fichier EOS
Do While fic_EOS <> ""

    If fichier1 <> toute_source.Cells(18, 2) Then fin = True
    Workbooks.Open path_EOS & fichier1
    Set Input_EOS = Application.ActiveWorkbook

For i = 2 To Input_EOS.Sheets(1).Cells(Rows.Count).End(xlUp).Row
For j = 19 To toute_source.Cells(Rows.Count).End(xlUp).Row

            If Input_EOS.Sheets(1).Cells(i, 6).Value = toute_source.Cells(j, 1) Or Input_EOS.Sheets(1).Cells(i, 6).Value = toute_source.Cells(j + 1, 1) Or Input_EOS.Sheets(1).Cells(i, 6).Text = toute_source.Cells(j + 2, 1) Then
                toute_source.Cells(18, 3) = "OK"
            ElseIf Input_EOS.Sheets(1).Cells(i, 6).Value < toute_source.Cells(j, 1) Then GoTo erreur
            End If
erreur:
            toute_source.Cells(18, 3) = "Pas OK"
            Exit sub
Next
Next
    End if
        Input_EOS.Close savechanges:=False
        fichier1 = Dir(fic_EOS)
Loop

End Sub

Encore un code ??? C'est le même que le précédent non ?
Et pourquoi un autre fichier ?

Merci de répondre aux questions de mon post précédent

Oui c'est ça je voudrais vérifier que les dates présent dans le fichier 211119 soit bien les mêmes que dans test date et qu'elles ne soient pas autre

Actuellement je ne l'ai pas enlevé, je comptais surement l'utiliser plus tard (Date_reporting) mais ne faites pas attention.

J'ai changé le fichier pour qu'il n'y aie qu'un lien

Oui c'est ça je voudrais vérifier que les dates présent dans le fichier 211119 soit bien les mêmes que dans test date et qu'elles ne soient pas autre

Comme demandé précédemment, si une date est différente le code doit s'arrêter ou pas ?

J'ai rectifié la feuille excel, les dates se trouve à partir de A19 à A21 et voici le nouveau fichier mis à jour.

Dans B20 et B21, ils devait avoir d'autre lien menant à d'autres dossiers similaire , mais je voulais faire un test avec celui ci, si ça fonctionne.

Si vous avez l'intention de mettre des liens en A19 et A20 autant le prévoir dans le code sans quoi vous allez devoir refaire tout après

Oui si aucune date n'appartient à la liste des dates dans test date, on sort de la boucle.

Pour les liens de A19 et A20, ce n'est pas tres propre mais je comptais faire un copier coller de ce que va donner le premier test mais en modifiant les variables. Faire 3 do while/ Loop au lieu d'une seule

Pour les liens de A19 et A20, ce n'est pas tres propre mais je comptais faire un copier coller de ce que va donner le premier test mais en modifiant les variables. Faire 3 do while/ Loop au lieu d'une seule

Je ne vois pas de souci.
Si vous avez toujours 3 liens entre A19 et A21, 3 fichiers en colonne B et 3 Dates à contrôler, il suffit de prévoir cela avant.

Tres bien je note pour faire la modification plus tard.

Essayez le code peu comme ceci :

Sub controle_date_import()
Dim toute_source As Worksheet
Dim Input_EOS As Workbook
Dim j As Byte
Dim i As Long
Dim path_EOS As String
Dim fic_EOS As String
Dim fichier As String

Set toute_source = ThisWorkbook.Sheets("source")

'date_reporting = toute_source.Cells(1, 1)
path_EOS = toute_source.Cells(18, 1)
fic_EOS = Dir(path_EOS)
fichier = toute_source.Cells(18, 2)
j = 21

Do While fic_EOS <> ""

        Workbooks.Open path_EOS & fichier
        Set Input_EOS = Application.ActiveWorkbook

        For i = 2 To Input_EOS.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
            Select Case Input_EOS.Sheets(1).Cells(i, 6).Value
                Case Is = toute_source.Cells(j, 1): toute_source.Cells(18, 3) = "OK"
                Case Is = toute_source.Cells(j + 1, 1): toute_source.Cells(18, 3) = "OK"
                Case Is = toute_source.Cells(j + 2, 1): toute_source.Cells(18, 3) = "OK"
                Case Else
                    toute_source.Cells(18, 3) = "Pas OK": Exit Sub
            End Select
        Next i
    Input_EOS.Close savechanges:=False
    fichier = Dir(fic_EOS)
Loop
End Sub

Les conditions à respecter sont :
- Une seul lien actuellement entre A18
- Trois dates (obligatoire !) à mettre entre A21 et A23

Edit : Code amendé

Le code fonctionne par contre j'ai des questions :

1) la variable j qui pointe sur les date du fichier test, me fait sortir de la boucle alors que la date 19/11/2021 appartient à la liste des dates qui sont dans test date.Je vous renvoie un fichier source plus conséquent

Par ailleurs merci pour votre expertise en vba.

1) la variable j qui pointe sur les date du fichier test, me fait sortir de la boucle alors que la date 19/11/2021 appartient à la liste des dates qui sont dans test date.Je vous renvoie un fichier source plus conséquent

Je viens de tester et pas de souci. Attention que j'ai modifié le code.
reprenez l'actuel posté et refaites un test

Attention à votre nom de fichier qui est différent de celui posté en B18 (pourquoi d'ailleurs ?)

Ah je n'ai rien dit erreur d'inattention de fichier ne tenez pas compte de mon message. J'ai tout retesté et ça fonctionne. Merci à vous pour cette resolution de probleme et encore desolé pour les erreurs d'inattention.

1 par ailleurs j'ai retesté en faisant une deuxième boucle Do while sur un autre fichier, la macro repasse sur la première boucle en mettant une erreur 1004 : fichier déplacé renommé au lieu de passer à l'autre boucle. pourtant le fichier n'a pas été déplacé, il a bien mis le statut à jour mais ne passe pas à la deuxieme boucle.

2 Egalement Le fichier ne se ferme pas également malgré que la workbook.close est présente.

je vous joins 211119-VL2 qui est l'autre fichier source et test-datev2-0 qui est la version avec les deux boucles.

Avez vous une idée ?

La structure de votre fichier Vl2 n'est plus la même. les dates sont en colonne D au lieur de F
Si vous ne figez pas les fichiers on ne va jamais y arriver

Ne me postez pas un nouveau fichier sans quoi je dois chaque fois recommencer.

Dites moi où les dates vont se trouver en F ou en D ?

en D pour le second fichier

En supposant les Path placé entre A18 et A20, essayez comme ceci :

Sub controle_date_import2()
Dim toute_source As Worksheet
Dim Input_EOS As Workbook
Dim j As Byte, k As Byte
Dim i As Long
Dim path_EOS As String
Dim fic_EOS As String
Dim fichier As String

Set toute_source = ThisWorkbook.Sheets("source")

For k = 0 To 2

    path_EOS = toute_source.Cells(18 + k, 1)
    fic_EOS = Dir(path_EOS)
    fichier = toute_source.Cells(18 + k, 2)

    If fichier <> "" And path_EOS <> "" Then
        j = 21
        Workbooks.Open path_EOS & fichier
        Set Input_EOS = Application.ActiveWorkbook

            For i = 2 To Input_EOS.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
                Select Case Input_EOS.Sheets(1).Cells(i, 4).Value
                    Case Is = toute_source.Cells(j, 1): toute_source.Cells(18 + k, 3) = "OK"
                    Case Is = toute_source.Cells(j + 1, 1): toute_source.Cells(18 + k, 3) = "OK"
                    Case Is = toute_source.Cells(j + 2, 1): toute_source.Cells(18 + k, 3) = "OK"
                    Case Else
                        toute_source.Cells(18 + k, 3) = "Pas OK": Exit For
                End Select
            Next i
        Input_EOS.Close savechanges:=False
        fichier = Dir(fic_EOS)
    End If
Next k

End Sub