View Single Post
 
Old 09-24-2020, 06:46 AM
leeqiang leeqiang is offline Windows 10 Office 2019
Advanced Beginner
 
Join Date: Aug 2020
Posts: 38
leeqiang is on a distinguished road
Default How to modify the code to meet the corresponding requirements

The code traverses all the files in the folder and its subfolders and extracts the relevant information of the files. I want to make modifications based on the generated results. Column B is the file name of the extracted file. How to base the file name Add a hyperlink to the path where the file is located, so that you can open the corresponding file by directly clicking on a file name. Thank you!



Thank you very much for your help, your code solved my problem.
If you donít mind, can you help me solve a few further problems? Modified on the basis of this code to achieve the following 4 purposes:



The first one: The data in column D generated by the code is named path, but all the addresses in this column know the folder, and now I want to modify the path of each file to the full path name, that is, there is a file after the original path file name. That is to say, this path is a hyperlink and you can click to open the file directly, but the data in column D shows the complete path.



The second one: add an E column named the creation date of the file. After traversing each file, the creation date of each corresponding file is generated in this column.



Third: Add a column F named file modification date. After traversing each file, the last modification date of each corresponding file is generated in this column.



Fourth: Add a G column named file size, and generate the file size of each corresponding file in this column after traversing each file.

Thanks again, hope to help me!










  1. Dim jg(), k&, tms#
  2. Sub ListFilesFso()
  3. sb& = InputBox("Search Type: AllFiles=0/Files=1/Folder=-1/All Folder=-2", "Find Files", 0)
  4. SpFile$ = InputBox("typeoffiles", "Find Files", ".xl")
  5. If SpFile Like ".*" Then SpFile = LCase(SpFile) & "*"
  6. With Application.FileDialog(msoFileDialogFolderPicker)
  7. If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  8. End With
  9. If Right(myPath, 1) <> "" Then myPath = myPath & ""
  10. ReDim jg(65535, 3)
  11. jg(0, 0) = "Ext": jg(0, 1) = IIf(sb < 0, IIf(Len(SpFile), "Filename", "No"), "Filename")
  12. jg(0, 2) = "Folder": jg(0, 3) = "Path"
  13. tms = Timer: k = 0: Call ListAllFso(myPath, sb, SpFile)
  14. If sb < 0 And Len(SpFile) = 0 Then Application.StatusBar = "Get " & k & " Folders."
  15. [a1].CurrentRegion = "": [a1].Resize(k + 1, 4) = jg: [a1].CurrentRegion.AutoFilter Field:=1
  16. End Sub
  17. Function ListAllFso(myPath$, Optional sb& = 0, Optional SpFile$ = "")
  18. Set fld = CreateObject("Scripting.FileSystemObject").GetFold er(myPath)
  19. On Error Resume Next
  20. If sb >= 0 Or Len(SpFile) Then
  21. For Each f In fld.Files
  22. t = False
  23. n = InStrRev(f.Name, "."): fnm = Left(f.Name, n - 1): x = LCase(Mid(f.Name, n))
  24. If Err.Number Then Err.Clear
  25. If SpFile = " " Then
  26. t = True
  27. ElseIf SpFile Like ".*" Then
  28. If x Like SpFile Then t = True
  29. Else
  30. If InStr(fnm, SpFile) Then t = True
  31. End If
  32. If t Then k = k + 1: jg(k, 0) = x: jg(k, 1) = "'" & fnm: jg(k, 2) = fld.Name: jg(k, 3) = fld.Path
  33. Next
  34. Application.StatusBar = Format(Timer - tms, "0.0s") & " Get " & k & " Files , Searching in Folder ... " & fld.Path
  35. End If
  36. For Each fd In fld.SubFolders
  37. If sb < 0 And Len(SpFile) = 0 Then k = k + 1: jg(k, 0) = "fld": jg(k, 1) = k: jg(k, 2) = fd.Name: jg(k, 3) = fld.Path
  38. If sb Mod 2 = 0 Then Call ListAllFso(fd.Path, sb, SpFile)
  39. Next
  40. End Function

Last edited by leeqiang; 09-24-2020 at 05:07 PM.
Reply With Quote