Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Compter le nb de Fichier dans un dossier afin de créer une nouvelle version

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Y

youguybass

XLDnaute Junior
Bonjour à tous
Je cherche à compter dans un dossier, le nb de fichier qui aurait les 12 premiers caractères identiques à une variable "NumCom" par exemple
Dans le dossier (en image) ci-dessous en exemple je voudrais que si je faisait une nouvelle version de la OUT 2027-016, celle-ci soit appelée OUT 2027-016 _ SNM Métal _ Version 6
Que si je créé une nouvelle commande OUT 2027-019 _ ToTo , cela me crée comme fichier OUT 2027-019 _ ToTo _ Version 1

D'avance merci

VB: 
Sub CréatPDFCommande()
Dim NumCom As String, DosDépot As String, DosRacine As String, An%, Fournisseur, Indice

Fournisseur = Page17_2Commandes.ComboBox1

NumCom = TextBox26       ' Num Commande
An = Left(Split(NumCom, " ")(1), 4) 'Récupère l'année de la commande

DosRacine = "I:\Chevalerias\" ' // Peut-être à adapter
DosDépot = "Commandes " & An        ' // Nom du dossier de dépot voulu
Indice = 1

'***************************
'On Error Resume Next: ChDrive DosRacine: ChDir DosRacine & DosDépot
'If Err Then MkDir DosRacine & DosDépot: ChDir DosRacine & DosDépot

'Ci-dessus ou ci-dessous les 2 fonctionnent

Dim cheminDossier As String
cheminDossier = DosRacine & "\" & DosDépot  ' Assure le \ entre les deux

If Dir(cheminDossier, vbDirectory) = "" Then
    MkDir cheminDossier
End If
'*********************************

Dim CheminCommande As String
CheminCommande = cheminDossier & "\" & NumCom & " _ " & Fournisseur & " _ Version " & Indice & ".pdf"
'Indice = Left(Split(CheminCommande, " ")(1), 4)
Indice = Right(Split(CheminCommande, " ")(1), 1)

MsgBox Indice

If Dir(CheminCommande, vbDirectory) <> "" Then
    If MsgBox("Le PDF de cette commande existe déja" & Chr(10) & "Voulez vous l'écraser? ", vbYesNo + vbExclamation) = vbYes Then

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DosRacine & DosDépot & "\" & NumCom & " _ " & Fournisseur & " _ Version " & Indice & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Else
    
  If MsgBox("Voulez vous faire évoluer l'indice" & Chr(10) & "Blabla", vbYesNo + vbExclamation) = vbYes Then
    Indice = Indice + 1
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DosRacine & DosDépot & "\" & NumCom & " _ " & Fournisseur & " _ Version " & Indice & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        Else: Exit Sub
        End If
    
    End If
 
    Else 'Pour créer les PDF s'il n'existe pas
    Indice = 1
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DosRacine & DosDépot & "\" & NumCom & " _ " & Fournisseur & " _ Version " & Indice & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
 
End If

    End Sub
 
Solution
Bonjour,
Code spécifique à votre demande, je pense que cela devrait fonctionner également avec des dossiers réseau :
VB: 
Sub CréatPDFCommande()
    Dim NumCom As String, DosDépot As String, DosRacine As String, An%, Fournisseur, Indice
    Dim cheminDossier As String
    Dim Target As String, Base As String
   
    Fournisseur = "SNM Métal"           ' Fournisseur = Page17_2Commandes.ComboBox1
    NumCom = "OUT 2027-016"             ' NumCom = TextBox26        ' Num Commande
    An = Left(Split(NumCom, " ")(1), 4) 'Récupère l'année de la commande
   
    DosRacine = "O:\Chevalerias"        ' Peut-être à adapter
    If Dir(DosRacine, vbDirectory) = "" Then MkDir DosRacine
   
    DosDépot = "Commandes " & An        ' Nom du dossier de...
Trier par date Trier par votes
Bonjour,
Code spécifique à votre demande, je pense que cela devrait fonctionner également avec des dossiers réseau :
VB: 
Sub CréatPDFCommande()
    Dim NumCom As String, DosDépot As String, DosRacine As String, An%, Fournisseur, Indice
    Dim cheminDossier As String
    Dim Target As String, Base As String
   
    Fournisseur = "SNM Métal"           ' Fournisseur = Page17_2Commandes.ComboBox1
    NumCom = "OUT 2027-016"             ' NumCom = TextBox26        ' Num Commande
    An = Left(Split(NumCom, " ")(1), 4) 'Récupère l'année de la commande
   
    DosRacine = "O:\Chevalerias"        ' Peut-être à adapter
    If Dir(DosRacine, vbDirectory) = "" Then MkDir DosRacine
   
    DosDépot = "Commandes " & An        ' Nom du dossier de dépot voulu
       
    cheminDossier = DosRacine & "\" & DosDépot  ' Assure le \ entre les deux
    If Dir(cheminDossier, vbDirectory) = "" Then MkDir cheminDossier
   
    Base = cheminDossier & "\" & NumCom & " _ " & Fournisseur & " _ Version "
    Indice = Next_Version(Base)
    If Not IsEmpty(Indice) _
    Then ActiveSheet.ExportAsFixedFormat _
            Filename:=Base & Indice & ".pdf", _
            Type:=xlTypePDF, OpenAfterPublish:=False
           
End Sub
Function Next_Version(Target As String) As Variant
    T = Split(Target, "\")
    Extension = "Pdf"
    Drive = T(0): T(0) = ""
    FileToSearch = T(UBound(T)) & "%": T(UBound(T)) = ""
    Path = Join(T, "\\")

    Sql = "Select * from CIM_DataFile" _
        & " where Hidden=False" _
        & "   and Extension='" & Extension & "'" _
        & "   and Drive='" & Drive & "'" _
        & "   and Path='" & Path & "'" _
        & "   and Filename like '" & FileToSearch & "'"
    
    Set WMIService = GetObject("winmgmts:" & "!\\.\root\cimv2")
        Set ListFiles = WMIService.ExecQuery(Sql)
        On Error GoTo Error_Exit
        For Each File In ListFiles
            T = Split(File.Filename)
            If Val(T(UBound(T))) = T(UBound(T)) Then
                Next_Version = Application.Max(Next_Version, T(UBound(T)))
            Else
                Err.Raise 600, "Next_Version", _
                    T(UBound(T)) & " est inattendu en fin du fichier" & vbLf & File.Filename
            End If
        Next
    Set WMIService = Nothing
    Next_Version = Next_Version + 1

Error_Exit:
    If Err Then MsgBox Err.Description, vbCritical
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Y
  • Résolu(e)
XL 2019 Vérification si dossier existe et création s'il n'existe pas
Réponses
3
Affichages
122
youguybass
Y
L
  • Question Question
XL 2016 Enregistrer une zone dans un PDF
Réponses
2
Affichages
380
patricktoulon
F
  • Question Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
554
firecarl
F
  • Question Question
XL 2019 envoi pdf d'une feuille par gmail et non pas par outlook
Réponses
7
Affichages
384
pascal21
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
663
MarineU
M
N
  • Résolu(e)
Microsoft 365 Macro enregistrement automatique pdf
2
Réponses
18
Affichages
985
Nounours4173
N
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
672
Phil69970
P
  • Question Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
867
job75
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
783
ph.vanne
N
  • Question Question
Autres bouton d'action sous excel
Réponses
6
Affichages
544
wDog66
W
P
  • Résolu(e)
Microsoft 365 creer un dossier et sauvergarder un fichier PDF avec le meme nom
Réponses
5
Affichages
813
Lolote83
L
  • Question Question
XL 2021 Comment créer un code VBA afin de création un chemin d'accès universel
Réponses
8
Affichages
1 K
AugusteP
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
1 K
Nico2978
  • Question Question
XL 2021 Ouverture d'un PDF à l'aide d'un bouton clic et pour multi utilisateur PC
Réponses
3
Affichages
637
AugusteP
M
  • Question Question
Microsoft 365 pb enregistrement PDF de plusieurs feuilles d'un classeur excel
2
Réponses
15
Affichages
2 K
MG_000
M
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
1 K
JPaul78
J
G
  • Question Question
XL 2016 enregistrer PDF avec choix de dossier
Réponses
2
Affichages
3 K
Gilles Cyr
G
E
  • Résolu(e)
Microsoft 365 Enregistrement en PDF avec modification du nom en fonction du contenu de cellules
Réponses
2
Affichages
1 K
Elwer
E
  • Question Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
1 K
halecs93
  • Question Question
Microsoft 365 Exporter en PDF avec une mise en page automatique via un bouton
Réponses
8
Affichages
870
patricktoulon
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…