I have responded to this already in post #5.Can we also change read write access settings using VBA, in case you are not an admin
'----------------------------------------------------------------------------------------------------------------------
'If you are copying and changing this code then do not forget to add:
'Tools | References | Microsoft Shell Controls and Automation
'----------------------------------------------------------------------------------------------------------------------
Option Explicit
Option Compare Text 'We might come across mixtures of uppercase lowercase letters sometimes
Public objShApp As Shell
Public i As Long
Public Sub RunFileFolderList()
Dim strPath As String
'----------------------------------------------------------------------------------------------------------------------
'Setting the worksheet to list results from row 11 and performing cleanup to remove previous listings
'----------------------------------------------------------------------------------------------------------------------
i = 11
If Range("A" & Rows.Count).End(xlUp).Row > i Then Range("A11:C" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
With Application
.ScreenUpdating = False
ListItemsInFolder Range("A9").Value, Range("B9").Value
.ScreenUpdating = True
End With
Set objShApp = Nothing
End Sub
Public Sub ListItemsInFolder(strPath As String, boolSubFolder As Boolean)
Dim fldItem As FolderItem
If objShApp Is Nothing Then Set objShApp = New Shell
'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With objShApp.Namespace(strPath)
For Each fldItem In .Items
'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
If InStr(fldItem.Parent, ".zip") = 0 Then
If fldItem.IsFolder Then
If InStr(fldItem.Path, ".zip") = 0 Then
Cells(i, 1).Value = fldItem.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
End If
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
End If
If fldItem.IsFolder And boolSubFolder Then ListItemsInFolder fldItem.Path, boolSubFolder
End If
Next fldItem
End With
End Sub
There's a clue in the code itself if you want such modificationReally master piece code..
Can you modify to see it pick up only excel files from folder and sub folders
.Code:'---------------------------------------------------------------------------------------------------------------------- 'If you are copying and changing this code then do not forget to add: 'Tools | References | Microsoft Shell Controls and Automation '---------------------------------------------------------------------------------------------------------------------- Option Explicit Option Compare Text 'We might come across mixtures of uppercase lowercase letters sometimes Public objShApp As Shell Public i As Long Public Sub RunFileFolderList() Dim strPath As String '---------------------------------------------------------------------------------------------------------------------- 'Setting the worksheet to list results from row 11 and performing cleanup to remove previous listings '---------------------------------------------------------------------------------------------------------------------- i = 11 If Range("A" & Rows.Count).End(xlUp).Row > i Then Range("A11:C" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents With Application .ScreenUpdating = False ListItemsInFolder Range("A9").Value, Range("B9").Value .ScreenUpdating = True End With Set objShApp = Nothing End Sub Public Sub ListItemsInFolder(strPath As String, boolSubFolder As Boolean) Dim fldItem As FolderItem If objShApp Is Nothing Then Set objShApp = New Shell '---------------------------------------------------------------------------------------------------------------------- 'Shell's Namespace object holds onto many different and useful properties that can used to extract information 'In this code we have used its FileSystemObject equivalents '---------------------------------------------------------------------------------------------------------------------- With objShApp.Namespace(strPath) For Each fldItem In .Items '---------------------------------------------------------------------------------------------------------------------- 'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you 'an RTE so to bypass this possibility we use following check of verifying .zip '---------------------------------------------------------------------------------------------------------------------- If InStr(fldItem.Parent, ".zip") = 0 Then If fldItem.IsFolder Then If InStr(fldItem.Path, ".zip") = 0 Then Cells(i, 1).Value = fldItem.Path ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here" i = i + 1 Else Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2) Cells(i, 2).Value = fldItem.Name ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here" i = i + 1 End If Else Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2) Cells(i, 2).Value = fldItem.Name ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here" i = i + 1 End If If fldItem.IsFolder And boolSubFolder Then ListItemsInFolder fldItem.Path, boolSubFolder End If Next fldItem End With End Sub
I didn't say that the option was readily available but it is there as a clue.Didn't find any such option to display only excel files
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
End If
Else
If InStr(fldItem.Name, Range("C9").Value) > 0 Then 'INSTR IF LOOP
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
CreateThreeFilters Cells(i, 3), fldItem.Path
i = i + 1
End If 'INSTR IF LOOP
End If
You can always filter the file results in Excel (Column B).Just amazing.
Can you also add option to search a file from excel.
I mean a option where you can write the name of the file in a cell and press search button.
Agreed, I can filter it.You can always filter the file results in Excel (Column B).
Did you try putting the search value in cell C9 and test?Agreed, I can filter it.
What I mean is as below.
Let's say location is c:/New folder.
Add "Newfile.xls" in top rows and hit the search button.
Excel should now search for the file name in the directory mentioned.
You have given an option to display file with specific extention like .xlsx...
But I guess the search option would be helpful
I will ask the same question again:Wanted partial searching.
For example if there is a file named "newfile.xlsx", and if I search for the word " new," this file should populate.
If possible can we also use Search as you type like google search
It just came out of my imagination.
No, didn't work.I will ask the same question again:
Did you put value "new" in cell C9 and tried to see what results you get?