Dim objShell, varMyDoc, FSO, strCurrentFav, strNewFav

Set objShell = CreateObject("WScript.Shell")
Set varMyDoc = objShell.SpecialFolders("MyDocuments")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set strCurrentFav = objShell.SpecialFolders("Favorites")
Set strNewFav = varMyDoc & "Favorites"


Function CreateFolder(strCurrentFav, strNewFav, FSO)
   Set f = FSO.CreateFolder(strNewFav)
   CreateFolder = f.Path
   Call CopyFolder(strCurrentFav, strNewFav, FSO)
End Function

Function CopyFolder(strCurrentFav, strNewFav, FSO)
   FSO.CopyFolder strCurrentFav, strNewFav
End Function

Function ReportFolderStatus(strCurrentFav, strNewFav, FSO)
   If (FSO.FolderExists(strNewFav)) Then
      Call CopyFOlder(strCurrentFav, strNewFav, FSO)
   Else
      Call CreateFolder(strCurrentFav, strNewFav, FSO)
   End If
End Function

Call ReportFolderStatus(strCurrentFav, strNewFav, FSO)