Tester la précence de la date dans le nom d'un fichier

F

fred2705

XLDnaute Junior
Bonjour,

J'ai un code qui va tester si le nom de fichier existe déjà dans un répertoire mais j'aimerais qu'il ne tienne pas compte de l'exactitude de la date mais seulement du format.

Voici le type de nom de fichier qu'il doit reconnaitre comme existant :
P15.15.15__Contact__13.02.2015 V
P15.15.15__Contact__22.07.2015 V

Ces deux noms sont identique sauf la date mais j'aimerais simplement qu'il les considère comme identique lorsque on active le code suivant:


Code: 
    If FSO.fileExists(sChemin & "\" & [COLOR="#0000FF"][/COLOR][COLOR="#0000FF"]ActiveSheet.Range("P1").Text [/COLOR]& "__" & [COLOR="#008000"][/COLOR][COLOR="#008000"]ActiveSheet.Range("F1").Text [/COLOR]& "__" & [COLOR="#FF0000"]date_test[/COLOR] &[COLOR="#800080"][/COLOR][COLOR="#800080"] " V"[/COLOR] & ".pdf") = True Then

[COLOR="#FF0000"]date_test = Format("dd.MM.yyyy")[/[/COLOR]CODE]


Pouvez-vous m'aider a adapter ce code correctement ?
Merci bcp pour votre aide
 
Dernière édition:
Trier par date Trier par votes
F

fred2705

XLDnaute Junior
Re : Tester la précence de la date dans le nom d'un fichier

Merci pour l'aide,

Mais le souci c'est que j'ai une incrémentation V, V2, V3 ... et si je change la date il enregistre le fichier comme ceci:

P15.15.15__Contact__13.02.2015 V
P15.15.15__Contact__13.02.2015 V2
P15.15.15__Contact__13.02.2015 V3
P15.15.15__Contact__27.06.2015 V

L'incrémentation recommence a V au lieu de continuer à V4???

Pour info voici le code complet:

Code: 
Option Explicit

Private Function RenommerFichier(sChemin As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim i As Long
Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.fileExists(sChemin & "\" & sNomFichier & ".pdf") = True Then
        sNouveauNom = sNomFichier
        i = 1
        While FSO.fileExists(sChemin & "\" & sNouveauNom & ".pdf") = True
            i = i + 1
            sNouveauNom = sNomFichier & Chr(40) & Format(i, "0") & Chr(41)
        Wend
        sNomFichier = sNouveauNom
    End If
    Set FSO = Nothing
    RenommerFichier = sNomFichier
End Function

Sub PdfCreator()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim sNouveauNomPDF As String


    Range("O639").Select
    selection.Copy
    Range("V643").Select
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        

sNomPDF = ActiveSheet.Range("P1").Text & "__" & ActiveSheet.Range("F1").Text & "__" & ActiveSheet.Range("M1").Text & " V"

   sCheminPDF = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\"
    
    sNouveauNomPDF = RenommerFichier(sCheminPDF, sNomPDF)

    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")

    With JobPDF
        .cStart "/NoProcessingAtStartup"
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNouveauNomPDF

        .cOption("AutosaveStartStandardProgram") = 1
        .cOption("UpdateInterval") = 0
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With

    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    JobPDF.cPrinterStop = False

    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
End Sub

Encore merci pour votre aide.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Tester la précence de la date dans le nom d'un fichier

Re,

Je pensais que mon code du post #2 vous ferait comprendre qu'il faut utiliser Dir où l'on peut introduire l'astérisque * comme caractère générique.

Et surtout pas FSO.fileExists.

Donc pour déterminer le nom du fichier, avec l'incrémentation :

Code: 
If Dir(sChemin & "\" & [P1] & "__" & [F1] & "__* V.pdf") = "" Then
  sNomFichier = [P1] & "__" & [F1] & "__" & date_test & " V.pdf"
Else
  i = 2
  While Dir(sChemin & "\" & [P1] & "__" & [F1] & "__* V" & i & ".pdf") <> ""
    i = i + 1
  Wend
  sNomFichier = [P1] & "__" & [F1] & "__" & date_test & " V" & i & ".pdf"
End If
A+
 
Vote positif 0 Vote négatif
F

fred2705

XLDnaute Junior
Re : Tester la précence de la date dans le nom d'un fichier

Désolé je suis un débutant en VBA

J'ai essayé comme ceci mais sans succès!!! je désespère!

Code: 
Option Explicit

Private Function RenommerFichier(sChemin As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim i As Long
Dim FSO As Object


If Dir(sChemin & "\" & ActiveSheet.Range("P1").Text & "__" & ActiveSheet.Range("F1").Text & "__* V" & ".pdf") = "" Then
  sNomFichier = ActiveSheet.Range("P1").Text & "__" & ActiveSheet.Range("F1").Text & "__" & "dd.MM.yyyy" & " V.pdf"
Else
  i = 2
  While Dir(sChemin & "\" & ActiveSheet.Range("P1").Text & "__" & ActiveSheet.Range("F1").Text & "__* V" & i & ".pdf") <> ""
    i = i + 1
  Wend
  sNomFichier = ActiveSheet.Range("P1").Text & "__" & ActiveSheet.Range("F1").Text & "__" & "dd.MM.yyyy" & " V" & i & ".pdf"
End If

End Function


Sub PdfCreator()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim sNouveauNomPDF As String


    Range("O639").Select
    selection.Copy
    Range("V643").Select
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        

sNomPDF = ActiveSheet.Range("P1").Text & "__" & ActiveSheet.Range("F1").Text & "__" & ActiveSheet.Range("M1").Text & " V"

   sCheminPDF = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\"
    
    sNouveauNomPDF = RenommerFichier(sCheminPDF, sNomPDF)

    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")

    With JobPDF
        .cStart "/NoProcessingAtStartup"
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNouveauNomPDF

        .cOption("AutosaveStartStandardProgram") = 1
        .cOption("UpdateInterval") = 0
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With

    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    JobPDF.cPrinterStop = False

    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Tester la précence de la date dans le nom d'un fichier

Re,

A priori votre fonction VBA ne va pas, il est plus simple de mettre son code directement dans la procédure Sub.

Par ailleurs si sCheminPDF se termine par "\", il ne faut pas ensuite en ajouter un après sChemin !!!

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Tester la précence de la date dans le nom d'un fichier

Bonjour fred2705, le forum,

A partir de ce qui précède j'ai modifié votre macro :

Code: 
Sub PdfCreator()
Dim Chemin$, date_test$, NomFichier$, i&, JobPDF As Object

    'à quoi sert ce copier-coller ???
    Range("O639").Select
    Selection.Copy
    Range("V643").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
    Chemin = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\"
    'Chemin = ThisWorkbook.Path & "\" 'plus facile pour tester
   
    date_test = Format([M1], "dd.mm.yyyy")
   
    If Dir(Chemin & [P1] & "__" & [F1] & "__* V.pdf") = "" Then
      NomFichier = [P1] & "__" & [F1] & "__" & date_test & " V.pdf"
    Else
      i = 2
      While Dir(Chemin & [P1] & "__" & [F1] & "__* V" & i & ".pdf") <> ""
        i = i + 1
      Wend
      NomFichier = [P1] & "__" & [F1] & "__" & date_test & " V" & i & ".pdf"
    End If
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")

    With JobPDF
        .cStart "/NoProcessingAtStartup"
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = Chemin
        .cOption("AutosaveFilename") = NomFichier
        .cOption("AutosaveStartStandardProgram") = 1
        .cOption("UpdateInterval") = 0
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
    
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    JobPDF.cPrinterStop = False

    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
End Sub
Je ne peux pas tester car je n'ai pas PdfCreator installé.

Bonne journée.
 
Vote positif 0 Vote négatif

Discussions similaires

chris6999
  • Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
118
mapomme
mapomme
T
  • Question
Microsoft 365 Ouvrir un fichier en fonction de sa date
Réponses
1
Affichages
155
sylvanu
sylvanu
T
  • Résolu(e)
XL 2010 VBA - Lister fichiers et décortiquer le nom des fichiers dans colonne A et B
Réponses
5
Affichages
168
sylvanu
sylvanu
T
  • Question
XL 2021 ajouter le sélecteur de date + le nom de la personne qui utilise le fichier Excel
Réponses
3
Affichages
344
patricktoulon
patricktoulon
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
239
fanch55
fanch55
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Réinitialiser le fichier initial
Réponses
10
Affichages
485
chaelie2015
chaelie2015
S
  • Question
XL 2021 Supprimer le nom de l'onglet dans les cellules d'un tableau
Réponses
3
Affichages
250
salbingu
S
R
  • Question
Microsoft 365 obtenir le nom d'un tableau
Réponses
8
Affichages
445
job75
job75
J
  • Question
Microsoft 365 Récupérer le nom et la date d'un fichier TXT
Réponses
3
Affichages
447
sylvanu
sylvanu
DragonBallZ1981
  • Question
Autres Feuille avec Date comme nom
Réponses
7
Affichages
583
DragonBallZ1981
DragonBallZ1981

Membres actuellement en ligne

3 membres et 70 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 329
Messages
2 087 334
Membres
103 519
dernier inscrit
Thomas_grc11