ActiveWorkbook.AddToFavorites
This may sound like a lot of work but it is a solution. The problem is you
are limited to the number of Files in a folder. If a user has too many files
in his favorites directory you can't add any more. There are two solutions.
Delete some files from the favorites directory or Add a new Subfolder to the
Favorites. The code below adds a new Subfolder in the persons favorites
called End Of Month. Then after the addtofavorite is executed it moves the
new shortcut to the End of Month Subfolder.
Sub MovetoNewFolder()
Const Addfolder = "End of Month"
Homedrive = Environ("Homedrive")
HomePath = Environ("HOMEPATH")
Favorite = Homedrive & HomePath & "My documents\Favorites"
EndofMonth = Favorite & "\" & Addfolder
Set FSOobj = CreateObject("Scripting.FileSystemObject")
'Test if End of Month folder exists
If Not FSOobj.folderexists(EndofMonth) Then
'create folder end of Month
Set FavoriteFolder = FSOobj.getfolder(Favorite)
FavoriteFolder.subfolders.Add Addfolder
End If
'Save in Faroites
ThisWorkbook.AddToFavorites
'Get new filename
FName = Dir(Favorite & "\" & ThisWorkbook.Name & "*.*")
'set object to new filename
Set ShortCut = FSOobj.getfile(Favorite & "\" & FName)
'move to subfolder
ShortCut.Move EndofMonth & "\" & FName
End Sub
"MeistersingerVonNurnberg" wrote:
Hi -
Anyway to disable .AddToFavorites?
I have a a macro that generates the end-of-month runs. It generates anywhere
from 2 to 70 different workbooks. If there are more, it can "overrun" the
users "favorites" folder.
Thanks
|