Enregistrement fichier avec ID

Question

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

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 !

Geof52 · Accepted Answer

Tu peux peut-etre compter de nombre de "*Demande d'achat_* .xlsm" qu'il y a dans le dossier et ajouter +1 pour l'ID suivant. Sub test() dossier = "C:\TEMP_GED\" ID = 0 Fichier = Dir(dossier) Do While Fichier &lt;&gt; "" If Fichier Like "*Demande d'achat_*.xlsm" Then ID = ID + 1 Fichier = Dir Loop MsgBox ID End Sub Ou l'ecrire : (perso je prefere) If Right(Fichier, 5) = ".xlsm" And Fichier Like "*Demande d'achat_*" Then ID = ID + 1 A+...