Je cherche une solution pour créer automatiquement des dossiers a partir du nom et de la date de création de fichier PDF.
Je m’explique j’ai une machine outils qui me créer des fichiers PDF sous forme de nom de ce genre (1001 BI029 201977 a la date du 18-10-2023 ).
Je voudrais que ca me créer un dossier en prenant que les 4 premiers chiffres donc 1001 avec le mois et l’année de création du fichier( ex: 1001-10-2023)
En sachant qu’en général la machine créer plein de fichier différents je voudrais que ceux commençant par les même chiffres se retrouve dans le même dossier suivant la date ( si y en a qui ont le même nom mais a une date différente, ca créer un autre dossier (ex: 1001-06-2024)).
Tout les fichiers se trouve au même endroit.
Au fur et a mesure des fichiers vont s’ajouter au dossier source, donc je voudrais que ceux ci aussi créer des dossiers.
Je sais pas si c’est possible de faire ca en sachant que je suis pas un spécialiste en informatique.
Const sPréfix = "C:\Temp\X0001-1\X00002-2\X0003-3\X0004-4\" '1ier partie du dossier des pdfs
Sub Créer_PDF()
Dim sMachine, MaDate, sFichier As String
MaDate = Date
Machine = "1234"
sFichier = sPréfix & Left(Machine, 4) & "-" & Format(MaDate, "mm-yyyy") & "\" & "1001 BI029 201977.pdf" 'nom du pdf que vous voulez créer
Créer_Dossiers sFichier 'vérifier si tous les dossiers existent
MsgBox "dossier existe !!!!", vbInformation, sFichier
End Sub
Sub Créer_Dossiers(Nom_Fichier As String)
Dim i, sp, s
sp = Split(Nom_Fichier, "\")
For i = 0 To UBound(sp) - 1
s = s & sp(i) & "\"
If i > 0 And Dir(s, vbDirectory) = "" Then MkDir s
Next
End Sub
Alors j’ai pas tout compris
J’ai tout mes fichiers dans un dossier " D:\tef\Nouveau dossier (2)\Nouveau dossier\PDF USINAGE "
J’ai changé l’adresse dans la macro mais ca me créer qu’un seul dossier et qui est au nom de 1234 et non au nom des fichiers.
En plus j’ai oublié mais si c’était possible de déplacer le fichier en question dans le dossier ca serait le top
Bonjour,
J’ai déjà créé des lignes qui font a peut prêt la même chose. et la voici :
Sub classement()
Dim emplacement As String
Dim Groupe_fichier As Object
Dim fichier As Object
Dim n As Integer
Dim dossier As Range
Dim a As FileDialog
n = 0
Range("AA:AA").NumberFormat = "@"
Range("AA3").Select
On Error GoTo nada
Set a = Application.FileDialog(msoFileDialogFolderPicker)
a.Show
emplacement = a.SelectedItems(1)
Set Groupe_fichier = CreateObject("scripting.filesystemobject").getfolder(emplacement)
Application.ScreenUpdating = False
For Each fichier In Groupe_fichier.Files
ActiveCell.Offset(n, 0) = Format(FileDateTime(fichier), "dd-mmm-yyyy")
n = n + 1
Next
ActiveCell.CurrentRegion.Name = "liste_repertoire"
For Each dossier In Range("liste_repertoire")
On Error Resume Next
MkDir emplacement & "/" & dossier
For Each fichier In Groupe_fichier.Files
If Format(FileDateTime(fichier), "dd-mmm-yyyy") = dossier Then
Name fichier As emplacement & "/" & dossier & "/" & fichier.Name
End If
Next
Next
ActiveCell.CurrentRegion.Clear
Application.ScreenUpdating = True
MsgBox "Fin du traitement"
Exit Sub
nada:
MsgBox "Vous avez pas choisi un emplacement"
'Will-Fread
End Sub
vous pouvez la modifier et l’adapter a vos besoin.
je vois que j’ai mal interpréter la question, donc au moment de la création du fichier je le déplace
le fichier de hier avec le nouveau path vers D et 2 méthodes, on crée le fichier et on le déplace ou on créee le fichier directement sur le bon endroit Jerome_Serton.xlsm (27,3 Ko)
Mais je pouvais modifier la méthode 1 pour boucler tous les fichiers, un peu comme Jacquinot (que je salue)
c’est l’avant-dernier fichier, non ? Vous vouliez quelque chose qui déplacait directement tous les pdfs, donc la macro « déplacer » ans le dernier ichier.
en fait le code de jacqinot fonctionne tres bien comme je veux juste faudrait que jarrive a recuperer les 4 premiers chiffres du nom des fichiers et l integrer au debut du nom de dossier et la date apres
Sub classement()
Dim Emplacement As String, sDossier, sNouveau, s
Dim Groupe_fichier As Object
Dim Fichier As Object
Dim n As Integer, n1 As Integer, n2 As Integer
Dim dossier As Range
Dim a As FileDialog
Set a = Application.FileDialog(msoFileDialogFolderPicker)
If a.Show = False Then Exit Sub
Emplacement = a.SelectedItems(1)
Set Groupe_fichier = CreateObject("scripting.filesystemobject").getfolder(Emplacement)
Application.ScreenUpdating = False
For Each Fichier In Groupe_fichier.Files
n = n + 1
If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,###") & Space(5) & Fichier.Name 'montrer le nom de chaque centième fichier
If LCase(Fichier.Name) Like "#### *.pdf" Then 'fichier est un pdf qui commence avec 4 chiffres et un espace
n1 = n1 + 1
'Debug.Print Format(n, "#,###"), n1, Fichier.Name
On Error Resume Next
s = "": s = Left(Fichier.Name, 4) & "-" & Format(FileDateTime(Fichier), "mm-yyyy") '4 chiffres du fichier & mois & année
On Error GoTo 0
If s = "" Then
MsgBox "problème, date inconnu", vbInformation, Fichier.Name
Else
sDossier = Emplacement & "\" & s 'nom du dossier destination
If Dir(sDossier, vbDirectory) = "" Then MkDir sDossier 'créer, s'il n'existe pas encore
sNouveau = sDossier & "\" & Fichier.Name 'nom du fichier dans ce nouveau dossier
If Dir(sNouveau) <> "" Then 'vérifier s'il n'existe pas encore
MsgBox "pdf existe déjà", vbCritical, sNouveau
Else
n2 = n2 + 1
Name Fichier As sNouveau
End If
End If
End If
Next
Application.StatusBar = ""
MsgBox Format(n, "#,###") & " fichiers dans " & Emplacement & vbLf & n1 & " pdfs traité " & vbLf & n2 & " pdfs déplacé"
End Sub
