VBA - Oprette genveje til alle undermapper i en mappe

Det kunne være noget i stil med nedenstående sub. Argumentet pSrc angiver hvilken mappe der skal checkes, og pDest angiver mappen hvor genvejene skal ligge. Bemærk, at destinationsmappenavnet skal afsluttes med "\", da der i koden tilføjes de ekstra tegn i genvejsnavnet.

Sub OpretGenveje(pSrc, pDest As String)

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

Set fcol = fso.GetFolder(pSrc).SubFolders
For Each sf In fcol
  Set link = wsh.CreateShortcut(pDest & "Dokumentation - " & sf.Name & ".lnk")
  link.TargetPath = src & "\" & sf.Name
  link.Save
  Next

End Sub