VB icon

Browse Favorites

Email
Submitted on: 1/5/2015 5:44:00 AM
By: Troy Demet (from psc cd)  
Level: Beginner
User Rating: By 14 Users
Compatibility: VbScript (browser/client side)
Views: 1413
 
     Using the Windows Scripting Host this VBScript retrieves the users favorites folder and loads the url links into an array, then goes to each site for three minutes.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Browse Favorites
' Description:Using the Windows Scripting Host this VBScript retrieves the users favorites folder and loads the url links into an array, then goes to each site for three minutes.
' By: Troy Demet (from psc cd)
'
' Inputs:User can input how many sites they wish to browse.
'**************************************

'==========================================================================
'
' 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


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.