Salut les kheys,( je ne sais pas si c'est le bon forum pour demander ça, sinon merci de m'indiquer mon chemin )
Je devais repertorier tout les fichiers d'un gros dossier et sous dossiers de ma boîte dans un fichier excel avec hyperlien pour chaque fichier.:mort:
Ça me paraissait impossible mais une kheyette m'a dit que ça avait un nom et je me suis démerdé pour trouver un script sur internet.:cimer:
Le script est presque parfait SAUF que:
-J'aimerais pouvoir choisir la cellule où s'affichera le résultat de la macro( actuellement ça commence toujours en A1)
- je dois modifier l'ordre des colonnes pour avoir Titre-type-date-Chemin afin de classer les futurs fichiers plus vites
- il me faudrait une version du script mais pour un seul fichier
Le script :
Sub MainList()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Dim folder_index As Integer
Dim file_extension As String
Dim file_type As String
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
folder_index = Range("B65536").End(xlUp).Row + 1
rowIndex = Range("F65536").End(xlUp).Row + 1
Cells(folder_index, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFolder.Path, TextToDisplay:=xFolder.Path
For Each xFile In xFolder.Files
file_extension = LCase(xFileSystemObject.GetExtensionName(xFile.Path))
If file_extension = "pdf" Then
file_type = "PDF"
ElseIf Left(file_extension, 3) = "doc" Then
file_type = "DOC"
ElseIf Left(file_extension, 2) = "xl" Then
file_type = "XLS"
ElseIf Left(file_extension, 3) = "msg" Then
file_type = "MSG"
ElseIf Left(file_extension, 3) = "zip" Then
file_type = "ZIP"
ElseIf Left(file_extension, 3) = "ppt" Then
file_type = "PPT"
Else
file_type = ""
End If
Cells(rowIndex, 6).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFolder.Path, TextToDisplay:=xFolder.Path
Cells(rowIndex, 7).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFile.Path, TextToDisplay:=xFile.Name
Cells(rowIndex, 8).Formula = file_type
Cells(rowIndex, 9).Formula = xFile.Size
Cells(rowIndex, 10).Formula = xFile.DateLastModified
Cells(rowIndex, 11).Formula = file_extension
rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SubFolders
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
Un khey deter sautait faire ça svp? Je pense pas que ce soit compliqué merci
Ps: je précise que je ne suis pas un informaticien je ne comprends rien à ça, j'ai juste testé des scripts randoms trouvés sur internet pendant 4H en sueur puis je me suis démerdé avec celui là pendant 3h de plus donc merci de ne pas partir dans des débats technique car je ne pourrais pas vous répondre
Fuis ce langage temps que tu le peux encore
Le 02 décembre 2020 à 14:47:08 cybevil a écrit :
Fuis ce langage temps que tu le peux encore
Merci mais actuellement c'est ce que j'ai trouvé de mieux
Quelqu'un saurait modifier la date de dernière modification du fichier en temps réel ?