This should place all found files in the desktop.<pre>Option Explicit
Private Type ****EMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ****EMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DESKTOP = &H0
Sub GetDesktopFiles()
Dim i As Long
Dim FSC As New FileSystemObject
Dim Fl As File
Cells(1, 1).Resize(1, 3).Value = Array("Name", "Path", "Type")
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = GetSpecialfolder(CSIDL_DESKTOP)
.Execute
For i = 1 To .FoundFiles.Count
Set Fl = FSC.GetFile(.FoundFiles(i))
Cells(i + 1, 1) = Fl.Name
Cells(i + 1, 2) = Fl.Path
Cells(i + 1, 3) = Fl.Type
Next i
End With
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long
Dim IDL As ITEMIDLIST
Dim Path$
'Get the special folder
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
'Create a buffer
Path$ = Space$(512)
'Get the path from the IDList
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Remove the unnecessary chr$(0)'s
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function</pre>
