Dim objShell, varMyDoc, fs, strCurrentFav, strNewFav

Set objShell = CreateObject("wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
varMyDoc = objShell.SpecialFolders("MyDocuments")
strCurrentFav = objShell.SpecialFolders("Favorites")
strNewFav = varMyDoc & "\Favorites"

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

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

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

If (strCurrentFav <> strNewFav) Then
   Call ReportFolderStatus(strCurrentFav, strNewFav, fs)
   objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Favorites", strNewFav, "REG_EXPAND_SZ"
End If