Advertisement
Guest User

Untitled

a guest
Apr 28th, 2015
197
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.74 KB | None | 0 0
  1. Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)
  2.  
  3. Dim fName As String
  4. Dim Lastrow As Long
  5.  
  6. On Error Resume Next
  7.  
  8. For Each FileItem In SourceFolder.Files
  9. ' display file properties
  10. Cells(iRow, 3).Formula = FileItem.Name
  11. Cells(iRow, 4).Formula = FileItem.Path
  12. iRow = iRow + 1 ' next row number
  13.  
  14. Next FileItem
  15.  
  16. Range("C17").CurrentRegion.Select
  17. Selection.Sort Key1:=Range("C17"), Order1:=xlAscending, Header:=xlGuess, _
  18. OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  19. DataOption1:=xlSortNormal
  20.  
  21. With ActiveSheet
  22. Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
  23. Lastrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  24. End With
  25.  
  26. If IncludeSubfolders Then
  27. For Each SubFolder In SourceFolder.SubFolders
  28. ListFilesInFolder SubFolder, True
  29. Next SubFolder
  30. End If
  31. Set FileItem = Nothing
  32. Set SourceFolder = Nothing
  33. Set FSO = Nothing
  34.  
  35. For iRow = 17 To Lastrow
  36. Cells(iRow, 2).Formula = iRow - 16
  37. ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 2), Address:="", _
  38. TextToDisplay:=CStr(iRow - 16)
  39. Next
  40.  
  41. End Sub
  42.  
  43. ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 2), Address:="", _
  44. TextToDisplay:=CStr(iRow - 16)
  45.  
  46. Activesheet.Hyperlinks.Add Anchor:=Cells(iRow, 2), Address:="", _
  47. ScreenTip:=CStr(iRow - 16)
  48.  
  49. ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 1), Address:="", ScreenTip:=CStr(Cells(1, 1).Value)
  50.  
  51. ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 1), Address:="", TextToDisplay:=Cstr("texthaschanged")
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement