Discussion :

[Nausiboy]

Bonjour,

J'ai un problème avec l'enregistrement des fichiers.
En faite j'enregistre mes fichier au format <ID "demande d'achat" émetteur fournisseur date du jour>
J'aimerais que l'ID s’incrémente a chaque nouvel enregistrement pour que les noms ce suivent.
Pour ce faire je test si le fichier existe déjà dans le répertoire ou se situe les fichiers.
Le problème c'est que cela marche que si j’enregistre plusieurs fichier le même jours car si je le fait a une autre date le fichier prend l ID 0 comme la date a change et qu'il pense que le fichier n'existe pas.
Peut t-on tester juste le début du nom d'un fichier ?
Y-a-t-il une autre solution ?

Merci d'avance !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub DEMANDE_DE_VALIDATION_CHEF_DE_SERVICE()
 
 
'declaration des variables'
Dim ID As Integer
Dim Fichier_existe As String
Dim NomDossier As String
Dim NomFichier As String
Dim NomFournisseur As String
Dim FichierAtester As String
Dim Emetteur As String
Dim Adresse_emetteur As String
Dim Adresse_recepteur As String
Dim Date_DA As String
 
 
ActiveSheet.Unprotect Password:="CIA"
 
 
'Recuperation de l'emetteur'
Adresse_emetteur = Application.UserName
Range("Z24").Value = Range("D3").Value
Date_DA = Range("Z24").Value
 
 
' Recuperation des infos du fichier parametre '
 
' MAINTENANCE'
If Range("D4").Value = "MAINT" Then
 NomDossier = Range("AE11")
 Adresse_recepteur = Range("Z11")
 
'GP'
ElseIf Range("D4").Value = "GP" Then
 NomDossier = Range("AE12")
 Adresse_recepteur = Range("Z12")
 
 'QUALITE'
ElseIf Range("D4").Value = "QUALITE" Then
 NomDossier = Range("AE13")
 Adresse_recepteur = Range("Z13")
 
 'RH'
ElseIf Range("D4").Value = "RH" Then
 NomDossier = Range("AE15")
 Adresse_recepteur = Range("Z15")
 
 'PROD B21'
ElseIf Range("D4").Value = "PROD B21" Then
 NomDossier = Range("AE14")
 Adresse_recepteur = Range("Z14")
 
'V-LOG'
ElseIf Range("D4").Value = "V-LOG" Then
 NomDossier = Range("AE16")
 Adresse_recepteur = Range("Z16")
 
 'IT'
ElseIf Range("D4").Value = "IT" Then
 NomDossier = Range("AE17")
 Adresse_recepteur = Range("Z17")
 
  'PROD B41'
ElseIf Range("D4").Value = "PROD B41" Then
 NomDossier = Range("AE18")
 Adresse_recepteur = Range("Z18")
 
End If
 
'CREATION DU NOM DU FICHIER'
NomFournisseur = Range("G5").Value
Emetteur = Range("D5").Value
NomFichier = ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
FichierAtester = NomDossier & ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
 
'TEST SI LE FICHIER EXISTE'
Fichier_existe = Dir(FichierAtester)
 
While Fichier_existe <> ""
    ID = ID + 1
    FichierAtester = NomDossier & ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
    NomFichier = ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
    Fichier_existe = Dir(FichierAtester)
Wend
 
If Fichier_existe = "" And Range("D4").Value <> "" And Range("D5").Value <> "" And Range("G5").Value <> "" Then
    On Error Resume Next
 
    ' Creation de l'adresse mail de l'emetteur'
    Adresse_emetteur = Replace(Adresse_emetteur, " ", ".")
    Range("X1").Value = Adresse_emetteur & "@velux.com"
 
    'actualisation du statut'
    Range("J5").Value = ID
    Range("M31").Interior.ColorIndex = 46
    Range("D3").Value = Date_DA
 
 
    'Envoie par mail au chef de service'
    ThisWorkbook.SendMail Adresse_recepteur, "Demande d'achat"
 
    'eregistrement d'une copie dans le repertoire'
    ActiveWorkbook.SaveCopyAs NomDossier & NomFichier
 
    Range("D4:D5").Value = ""
    Range("G5").Value = ""
    Range("B7:J46").Value = ""
 
 
Else
MsgBox ("Erreur : Service, Emetteur ou Fournisseur inconnu ")
End If
ActiveSheet.Protect Password:="CIA"
End Sub

[Franc]

Salut, teste comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim Fichier_existe As String
Fichier_existe = Dir("ID*")

[fraflt69]

Bonjour Nausiboy

Comme ID est un integer, je te suggère de le formater sur 6 Caractères, avec Format(ID,"000000"), il sera plus facile de trouver le compteur le plus haut, il faudra faire minima une boucle, peut-être avec une expression régulière.

[Nausiboy]

Merci Franc !
Merci Fraflt69 !

J'ai tester dir("ID*") mais malheureusement cela ne fonctionne pas le fichier garde l'ID 0 malgré qu'un fichier l'ai déjà.

Franc j'ai mit au bon format mais je ne comprend pas trop l'histoire de boucle, as-tu un exemple ?

Merci d'avance !

[Franc]

Ce n'est pas moi qui t'ai parlé de boucle. J'ai une autre suggestion que tu peux tester, dans ton code, remplace ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
'TEST SI LE FICHIER EXISTE'
Fichier_existe = Dir(FichierAtester)
 
While Fichier_existe <> ""
    ID = ID + 1
    FichierAtester = NomDossier & ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
    NomFichier = ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
    Fichier_existe = Dir(FichierAtester)
Wend

par ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
' Vérification si un fichier avec le même nom existe déjà dans le répertoire '
Fichier_existe = Dir(NomDossier & "*" & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm")
 
' Boucle pour parcourir les fichiers existants dans le répertoire '
While Fichier_existe <> ""
 
    ' Variables pour déterminer la position de l'ID dans le nom du fichier existant '
    Dim StartPosition As Integer
    Dim EndPosition As Integer
 
    ' Ignore le chemin d'accès et le séparateur de chemin dans le nom du fichier existant '
    StartPosition = Len(NomDossier) + 1
 
    ' Recherche la première occurrence de l'espace après le chemin d'accès et avant l'ID dans le nom du fichier existant '
    EndPosition = InStr(StartPosition, Fichier_existe, " ")
 
    ' Variable pour stocker l'ID extrait du nom du fichier existant '
    Dim ExistingID As Integer
 
    ' Extraction de l'ID du nom du fichier existant en utilisant les positions StartPosition et EndPosition '
    ExistingID = Val(Mid(Fichier_existe, StartPosition, EndPosition - StartPosition))
 
    ' Vérifie si l'ID existant est supérieur ou égal à l'ID actuellement en cours de génération '
    If ExistingID >= ID Then
 
        ' Si l'ID existant est supérieur ou égal, on incrémente l'ID actuel en conséquence '
        ID = ExistingID + 1
 
    End If
 
    ' Recherche le prochain fichier dans le répertoire pour continuer la boucle '
    Fichier_existe = Dir
 
Wend

[Nausiboy]

Oui désolé je me suis trompé.
Alors j'ai testé et cela ne marche pas il crée le fichier avec l'ID 0 car il a un fournisseur ou un émetteur différent.
J'ai aussi testé avec le même fournisseur et emetteur et cela crée une erreur sur la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    ExistingID = Val(Mid(Fichier_existe, StartPosition, EndPosition - StartPosition))

[fraflt69]

Attention, la commande DIR ne garantit jamais que le dernier fichier traité sera le dernier fichier écrit (de date de création comme de modification la plus récente).
je ne vois pas alors comment sans faire un test de comparaison de supériorité sur la partie ID, on pourra sélectionner le fichier qui donnera l'ID le plus haut pour l'incrémenter.

Pour que la partie date du nom du fichier permette de différencier le fichier le plus récent dans l'ordre de création, il faudrait rajouter l'heure, cela constituerait une deuxième facon de sélectionner ou de confirmer le dernier fichier créé.