VB icon

Browse Favorites

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: 1910
     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.
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
	End If
	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"
	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
		End If
	MsgBox "Quitting getFiles script"
	' Clean up after yourself
	Set ie = Nothing
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
	'Wait 3 minutes
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)
	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
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.