'**************************************
    ' Name: Browse Favorites
    ' Description:Using the Windows Scriptin
    '     g Host this VBScript retrieves the users
    '     favorites folder and loads the url links
    '     into an array, then goes to each site fo
    '     r three minutes.
    ' By: Troy Demet
    '
    ' Inputs:User can input how many sites t
    '     hey wish to browse.
    '
    'This code is copyrighted and has    ' limited warranties.Please see http://w
    '     ww.Planet-Source-Code.com/xq/ASP/txtCode
    '     Id.6104/lngWId.4/qx/vb/scripts/ShowCode.
    '     htm    'for details.    '**************************************
    
    '=======================================
    '     ===================================
    '
    ' VBScript Source File -- 
    '
    ' NAME: favoritesURL.vbs
    '
    ' AUTHOR: Troy Allen Demet , TechnoGeek,
    '     Inc.
    ' DATE : 2/25/00
    '
    ' COMMENT: This script will put the url 
    '     of your favorites into an array
    '			and then browse to each web site at 
    '     3 minute intervals.
    '
    '=======================================
    '     ===================================
    Option Explicit
    	Dim objShell, objWshShell, fso,fld, objFiles
    	Dim urlUpper, urlLower, Folder, j, ie, arURL(), fileCount, howMany
    	'Dim objFolder, file, count, fileType, holder
    	Set objShell = WScript.CreateObject("Shell.Application")
    	Set objWshShell = CreateObject("WScript.Shell")
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Folder = objWshShell.SpecialFolders	("Favorites")
    	Set fld = fso.GetFolder(Folder)
    	Set objFiles = fld.Files
    	fileCount = objFiles.Count
    	ReDim arURL(fileCount)
    	howMany = InputBox("Please enter how many sites you wish To browse.","How Many?",10)
    	if howMany < 1 Then
    		WScript.Quit	
    	End if
    	getFile(Folder)
    	urlUpper = UBound(arURL)				' Upper bound of arURL
    	urlLower = LBound(arURL)				' Lower bound of arURL	
    	if urlUpper < 1 Then
    		MsgBox "Sorry nothing To show",,"Nothing to Show"
    		WScript.Quit	
    	End if
    	if howMany > urlUpper Then
    		howMany = urlUpper - 1
    	End if
    	' Create the ie object (Internet Explorer)
    	Set ie = CreateObject("InternetExplorer.Application")
    	' Set the properties of Internet Explorer		
    	With ie
    		.left 		= 100
    		.top 		= 100
    		.height		= 460
    		.width		= 620
    		.menubar	= 0						' False
    		.toolbar	= 0						' False
    		.visible	= 1						' True
    	End With
    	' Loop through the array		
    	For j = urlLower To howMany
    		if arURL(j) <> "" Then
    			goUrl(arURL(j))
    		End if
    	Next
    	MsgBox "Quitting getFiles script"
    	' Clean up after yourself
    	ie.Quit
    	Set ie = Nothing
    	WScript.Quit	
    function readFile(filePath)
    	On Error Resume Next
    	Dim fileObject
    	Dim link, shellObject, line
    	Set fileObject = CreateObject("Scripting.FileSystemObject")
    	Set shellObject = CreateObject("Wscript.Shell")
    	Set link = shellObject.CreateShortcut(filePath)
    	' Use the MsgBox For debugging
    	 'MsgBox "temp" & vbCrLf & Link & vbCrLf & link.TargetPath
    	' Return the value
    	readFile = link.TargetPath	
    End function
    function goURL(aURL)
    	' go To the web site
    	ie.navigate(aURL)
    	'Wait 3 minutes
    	WSCript.Sleep(180000)
    End function
    Sub getFile (dir)
    	Dim objFolder, objSubFolder, objFiles, objSubFiles, Folder, subFolder, File, subFileCount, count
    	Dim fileType
    	Set objFolder = fso.GetFolder(dir)
    	Set objSubFolder = objFolder.SubFolders	
    	Set objFiles = objFolder.Files
    	For Each Folder In objSubFolder
    		Set subFolder = fso.GetFolder(Folder)
    		Set objSubFiles = subFolder.Files
    		subFileCount = objSubFiles.Count
    		fileCount = fileCount + subFileCount
    		ReDim Preserve arURL(fileCount)
    		getFile(Folder)
    	Next
    	File = 0
    	count = 0
    	For Each File In objFiles
    		fileType = File.Type
    		' Want only *.url files
    		if fileType = "Internet Shortcut" Then
    			'MsgBox "fullPath" & vbCrLf & File.Path
    			arURL(count) = readFile(File.Path)
    		End if
    		count = count + 1
    	Next	
    End Sub