Something like what I've got below is a slightly different approach but
should deliver close to what you want. Note that the CreateShortcut method
of the "Wscript.Shell" object returns a reference to a shortcut with its
properties exposed; a new shortcut is only created if you follow with the
Save method which we don't do here.

'--------------------------------------------

Sub FindSubfolders()
Dim strTopFolder As String
Dim strReport As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set wsh = CreateObject("WScript.Shell")

strTopFolder = "C:\Test"
strReport = ""

If Not fso.FolderExists(strTopFolder) Then
Exit Sub
End If

Set fldr = fso.GetFolder(strTopFolder)

For Each subFldr In fldr.Subfolders
strReport = strReport & subFldr.Path & vbCrLf
Next subFldr

For Each myFile In fldr.Files
If fso.GetExtensionName(myFile) = "lnk" Then
Set myLnk = wsh.CreateShortcut(myFile)
If fso.FolderExists(myLnk.TargetPath) Then
strReport = strReport & "Shortcut to " & myLnk.TargetPath &
vbCrLf
End If
Set myLnk = Nothing
End If
Next myFile

MsgBox strReport

Set fso = Nothing
Set wsh = Nothing
End Sub

'--------------------------------------------

Steve Yandl



"JoeU2004" wrote in message
...
The code below prints a list of subfolders in the specified folder.
However, it overlooks shortcuts to folders.

How can I include shortcuts to folders in the list, but not files and
shortcuts to files?

I think I want to know: how can I find the attribute of the object that a
shortcut ultimately links to?

(By "ultimately links to", I mean: the non-shortcut object, if a shortcut
links to a shortcut, if that is even possible in Win XP.)

Shortcuts to folders and files have only the attribute vbArchive on Win
XP, the same as normal files. (I suspect GetAttr returns zero if the
object has been backed up.)

Shortcuts are distinguishable from normal file by the extension ".lnk".
But shortcuts to folders seem indistinguishable from shortcuts to files.


Sub doit()
Const topdir As String = "C:\Documents and Settings\foo\My Documents\bar\"
Dim d As String, x As Long
d = Dir(topdir, vbDirectory)
While d < ""
x = GetAttr(topdir & d)
If InStr(d, ".lnk") Then stop 'debug
If x And vbDirectory Then Debug.Print d
d = Dir()
Wend
End Sub