Solved: Browsing for folder shell

[austenr]

The below code works as is if you select something other than Desktop, however, nothing is selected if you select desktop in the browser window.
anyone have any ideas? Thanks


[VBA] Sub Srch()

Dim i As Long, z As Long, ws As Worksheet, y As Variant
Dim fLdr As String
y = Application.InputBox("Please Enter File Extension", "Info Request")
If y = False And Not TypeName(y) = "String" Then Exit Sub
Application.ScreenUpdating = False
fLdr = BrowseForFolderShell
With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets.Add(Sheets(1))
On Error GoTo 1
2: ws.Name = "FileSearch Results"
On Error GoTo 0
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If Left$(.FoundFiles(i), 1) = Left$(fLdr, 1) Then
If CBool(Len(Dir(.FoundFiles(i)))) Then
z = z + 1
ws.Cells(z + 1, 1).Resize(, 3) = _
Array(Dir(.FoundFiles(i)), _
FileLen(.FoundFiles(i)) \ 1000, , _
FileDateTime(.FoundFiles(i)))
ws.Hyperlinks.Add Anchor:=Cells(z + 1, 1), _
Address:=.FoundFiles(i)
End If
End If
Next i
End If
End With

ActiveWindow.DisplayHeadings = False

With ws
With .[a1:c1 ]
.Value = [{"Full Name","Kilobytes","Last Modified"}]
.Font.Underline = xlUnderlineStyleSingle
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
.[d1:iv1 ].EntireColumn.Hidden = True
Range(.[a65536 ].End(3)(2), _
.[a65536 ]).EntireRow.Hidden = True
Range(.[a2 ], .[c65536 ]).Sort [a2 ], xlAscending, Header:=xlNo
End With

Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub [/VBA]

[VBA] Function BrowseForFolderShell() As String
Dim objShell As Object, objFolder As Object
Set objShell = CreateObject("Shell.Application")
' Uncomment next line to start at desktop
Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, 0)

'***Specify Starting Browse Location
'Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, "c:\")
If (Not objFolder Is Nothing) Then
On Error Resume Next
If IsError(objFolder.Items.Item.Path) Then BrowseForFolderShell = CStr(objFolder): GoTo Here
On Error GoTo 0
If Len(objFolder.Items.Item.Path) > 3 Then
BrowseForFolderShell = objFolder.Items.Item.Path & _
Application.PathSeparator
Else
BrowseForFolderShell = objFolder.Items.Item.Path
End If
Else: Application.ScreenUpdating = True: End
End If
Here:
Set objFolder = Nothing: Set objShell = Nothing
End Function [/VBA]

[mvidas]

Hi Austen,

It looks like your function is returning "Desktop" when the desktop is selected. You could add the following function:[vba]Function DesktopAddress() As String
DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop")
End Function[/vba]Then in your BrowseForFolderShell function, you could include this If line between Here: and when you set the objects to nothing:[vba]Here:
If BrowseForFolderShell = "Desktop" Then BrowseForFolderShell = DesktopAddress
Set objFolder = Nothing: Set objShell = Nothing[/vba]Just an idea
Matt

[austenr]

Thanks Matt. Works great. Solved.

[mvidas]

Glad to help!