Search Tools Links Login

Browse Favorites


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.

Original Author: Troy Demet

Inputs

User can input how many sites they wish to browse.

Code

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

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 123 times

Categories

ASP/ HTML

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.