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)