How to get vbscript to display a progress bar when running

[Wantabie]

Hello, I am new to vbscripting and found this neat little vbscript that i thought would be great to implement in a process i am currently working on. However, once started it does not indicate any progress or let's the user know that it is running.

I was wondering if there is a way to implement a progress bar script that will pop a form and show an indication of the progress.

The script is:

'This script backs up (copies) folders or files to a preset backup location and logs that last 5 backup files.
'This is a modified version of a script Tom Hingston submitted that only copies folders & files.
'~~[/comment]~~

'~~[script]~~
'MsHtis Data Backup Script 27 APRIL 2004
'
'This script copies all the files that are new or have changed,
'to the backup folder specified by BackupPath.
'It also logs the files copied from the last 5 backups to \\Hertz200\Net_Operations\Network Control\MsClosed\Backups\Backuplog.txt
'
'INSTRUCTIONS
'You need to change settings in 2 places below... Setting 1 is where to
'backup to; Setting 2 is what to backup. There is optional Setting 3 which
'allows you to exclude some sub-folders from within the folders being backed up.
'
'All file/folder paths need to be inside speech marks "Like this"
'or otherwise the speech marks need to be empty ""
'
' Learn about VBScript at...
'

http://msdn.microsoft.com/scripting/default.htm?/scripting/vbscript/

'==========================================================================


'==========================================================================
'SETTING 1 - WHERE TO BACKUP TO...
' Set BackupPath
' BackupPath is the Folder that you want to backup to....
' Example1: BackupPath = "B:\Backup"
' Example2: BackupPath = "\\<netserver>\Backups"

BackupPath = "\\Hertz200\Net_Operations\Network Control\MsClosed\Backups\HitsData" ' <-- Set backup path here

'END OF SETTING 1
'==========================================================================


If Wscript.Arguments.Count = 0 Then 'not initiated by dropping folder on it


'==========================================================================
'SETTING 2 - FILES AND/OR FOLDERS TO BACKUP...
'
'These are the Files and/or Folders that you want to backup.

Quantity = 20 '<-- This can be increased if MyData(?) increases.
redim MyData(Quantity)

' These are the Folders that you want to backup...
' EXAMPLE: MyData(1) = "C:\Data"

MyData(1) = "T:\Databases\Updates" '<-- Set these
MyData(2) = "T:\Databses\Web Pages"
MyData(3) = ""
MyData(4) = "T:\Databases\ldbuser.bas"
MyData(5) = "T:\Databases\ldbuser.frm"
MyData(6) = "T:\Databases\Ldbuser.vbp"
MyData(7) = "T:\Databases\Ldbuser.vbw"
MyData(8) = "T:\Databases\LDBView.exe"
MyData(9) = "T:\Databases\ldbview.frm"
MyData(10) = "T:\Databases\MouseWheel.dll"
MyData(11) = "T:\Databases\msldbusr.dll"
MyData(12) = "T:\Databases\chkfile.ozx"
MyData(13) = "T:\Databases\msdial.ozx"
MyData(14) = ""
MyData(15) = "T:\Databases\MsHits97Data.mdb"
MyData(16) = "T:\Databases\MsHitsData.mdb"
MyData(17) = "T:\Databases\MsDialData.mdb"
MyData(18) = ""
MyData(19) = "B:\Closed Tickets\MsClosed.mdb"
MyData(20) = "B:\Closed Tickets\MsClosedData.mdb"


'END OF SETTING 2
'==========================================================================


Else
redim MyData(1)
MyData(1) = Wscript.Arguments(0) 'was initiated by dropping folder on it
Quantity = 1
End If


'==========================================================================
'SETTING 3 - FOLDERS TO EXCLUDE... (optional)
'
'These are Sub-Folders within the folders being backed up,
'that you can Exclude from the backup.
'EXAMPLE: Excl_Data(1) = "C:\Data\Kids files"

Excl_Quantity = 5 '<-- This can be increased if Excl_Data(?) increases.
redim Excl_Data(Excl_Quantity)

Excl_Data(1) = "" '<-- Set these if required
Excl_Data(2) = ""
Excl_Data(3) = ""
Excl_Data(4) = ""
Excl_Data(5) = ""

'END OF SETTING 3
'==========================================================================


set fso = CreateObject("Scripting.FileSystemObject")


strScript = WScript.ScriptFullName
strScript = fso.GetFileName( strScript )
strScript = left( strScript, len(strScript) - 4 )

StartMe = msgbox("Welcome to MsHits Data Backup script." & vbCrlf & vbCrlf & _
"Backing up to " & BackupPath & " (" & strScript & ")" & vbcrlf & vbcrlf & _
"Would you like to start your backup now ?" , 33, "MsHtis Data Backup Script " & " - " & strScript )
if StartMe = 2 then 'cancelled
wscript.quit
End if


count = 0
dim arrResults ' array to store results in
redim arrResults(0)


If right(BackupPath, 1) <> "\" then
BackupPath = BackupPath & "\" 'inserts the slash as it is required later
End If

call CheckPath

if not fso.folderExists ( BackupPath ) then
fso.CreateFolder( BackupPath )
end if


'sets drv for MakeFolderPath
If left(BackupPath , 1) = "\" then 'network
for ss = 1 to len(BackupPath )
strCh = mid(BackupPath , ss, 1)
if strCh = "\" then countslash = countslash + 1
if countslash = 3 then
drv = ss + 3
end if
next 'ss
if not countslash >= 3 then msgbox "Error in script relative to network path"
else 'local drive letter
drv = 5
End If

For i = 1 to Quantity
If MyData(i) <> "" then

if fso.DriveExists( MyData(i) ) Then 'it is a drive
call backup( MyData(i) )

elseif fso.folderExists(MyData(i)) then 'it is a folder
call MakeFolderPath( BackupPath & right(MyData(i), len(MyData(i))-3 ) )
call backup( MyData(i) )

elseif fso.fileExists(MyData(i)) then 'it is a file
call FileBackup( MyData(i) )

else 'not a drive or folder or file
msgbox MyData(i) & vbcrlf & vbcrlf & "This file/folder does not appear to exist" & _
vbcrlf & "Please ensure you have typed it correctly or that" & vbcrlf & _
"you have not moved, renamed or deleted it.", 48, "File or Folder Error"
end if

End If
Next 'i

strlog = "----------------------" & vbnewline & "Backup on " & now() & vbnewline
strlog = strlog & join(arrResults, vbnewline) & vbnewline & "= " & count & " files copied to " & BackupPath & vbnewline & vbnewline
call logresults ( strlog )

ViewLog = msgbox("Backup to " & BackupPath & " Completed..." & vbnewline & "There were " & count & " files copied" &_
vbNewline & "Would you like to view the backup log now ?", vbYesno + 32 + 256, "MsHits Data Backup Script")
if ViewLog = 6 then 'yes
Set WshShell = WScript.CreateObject( "WScript.Shell" )
WshShell.Run ("""\\Hertz200\Net_Operations\Network Control\MsClosed\Backups\Backuplog.txt""") 'open log file
end if

Set WshShell = nothing
set fso = nothing
wscript.quit

'-------------------------------------------------------
'Performes the actual copying if required
Sub Backup( mypath )

if ExcludeF( mypath ) = False then
Set fldr = fso.GetFolder( myPath )
'Set fc = fldr.Files
For Each f in fldr.Files
DoEvents
If not fso.folderExists( BackupPath & right(myPath, len(myPath)-3 )) then
call MakeFolderPath( BackupPath & right(myPath, len(myPath)-3 ))
End if
If fso.DriveExists( mypath ) Then 'it is a drive
backfolder = BackupPath
else 'it is a folder
backfolder = BackupPath & right(fldr, len(fldr)-3 ) & "\"
end if


ext = right(Lcase(f.name), 3) '----------------------------
' FILE TYPES NOT TO BACK UP
'----------------------------
if ext <> "tmp" then

backupfile = backfolder & f.name

If fso.fileExists( backupfile ) then
if fso.GetFile(f).DateLastModified > fso.GetFile(backupfile).DateLastModified then
fso.CopyFile f, backfolder, true
count = count + 1
ReDim Preserve arrResults(count)
arrResults(count) = f
end if
Else 'does not yet exist in backup
fso.CopyFile f, backfolder, true
count = count + 1
ReDim Preserve arrResults(count)
arrResults(count) = f
End if
end if ' if ext.. that checked for filetype
DoEvents

Next 'f1

For Each Folder In fldr.SubFolders
Call Backup(Folder)
Next 'Folder

End if 'ExcludeF( mypath ) = False
End Sub

'-----------------------------------------------------------------
'performs the actual copying of Files if the path was a file - not folder
Sub FileBackup( myFile )

set f = fso.GetFile( myFile )
backupfile = BackupPath & f.name

If fso.fileExists( backupfile ) then 'already exists in backup
if fso.GetFile(f).DateLastModified > fso.GetFile(backupfile).DateLastModified then
fso.CopyFile f, BackupPath , true
count = count + 1
ReDim Preserve arrResults(count)
arrResults(count) = f
end if
Else 'does not yet exist in backup
fso.CopyFile f, BackupPath , true
count = count + 1
ReDim Preserve arrResults(count)
arrResults(count) = f
End if 'fso.fileExists( backupfile ) then

End Sub

'------------------------------------------------------------------
'if the folder does not yet exist in the backup path, make it.
Sub MakeFolderPath( myfolder )
For x = drv to len( myFolder )
MyChr = mid( myFolder , x, 1)
if mychr = "\" then
xfolder = left(myfolder, x-1)
if not fso.folderExists ( xFolder ) then
fso.CreateFolder( xFolder )
end if
end if
Next 'x
if not fso.folderExists ( myFolder ) then
fso.CreateFolder( myFolder )
end if
End sub

'----------------------------------------------------------------
'function that writes results to the log.txt
Sub LogResults( myText )
myfile = "C:\Backuplog.txt"

Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "C:\#temp#.txt"
set textstream = fspenTextFile(myFile,1,true)
Set OutStream=fso.CreateTextFile(OutFile,True)

OutStream.WriteLine( mytext )

Do until textstream.AtEndOfStream 'writes existing text to temp file
OneLine = textstream.ReadLine
OutStream.WriteLine(oneline)
if instr(Oneline, "----------") then 'finds start of each backup log
logcount = logcount + 1
if logcount >= 5 then
exit do
end if
end if
Loop

textstream.close
OutStream.Close
fso.CopyFile OutFile, myfile, true
fso.DeleteFile OutFile
End Sub

'----------------------------------------------------------------

Function ExcludeF(qF)
'On error resume next
for q = 1 to Excl_Quantity
if right(Excl_Data(q), 1) = "\" then
Excl_Data(q) = left(Excl_Data(q), len(Excl_Data(q))-1) 'removes last end if

If lcase(qF) = lcase(Excl_Data(q)) then
ExcludeF = True
Exit Function
End if
Next 'q

ExcludeF = False
End Function

'----------------------------------------------------------------

Function Excludefolder(qFolder)
'On error resume next
for q = 1 to Excl_Quantity
if right(Excl_Data(q), 1) = "\" then
Excl_Data(q) = left(Excl_Data(q), len(Excl_Data(q))-1) 'removes last end if

If lcase(qFolder) = lcase(Excl_Data(q)) then
Excludefolder = True
Exit Function
End if
Next 'q

Excludefolder = False
End Function

'-------------------------------------------------------------------

Sub DoEvents
'To cause script delays to allow system to still be used (doevents)
On error resume next
wscript.sleep 1 'milliseconds
End Sub
'-------------------------------------------------------------------

Sub CheckPath
'To ensure the backup path is not inside a folder being backed up

for p = 1 to Quantity
if not MyData(p) = "" then
if lcase(left(BackupPath , len(MyData(p)))) = lcase(MyData(p)) then
msgbox "You cannot back up a folder to a folder inside it" & vbcrlf &_
"because it will also backup the backup etc." & vbcrlf & vbcrlf &_
"Please use a different BackupPath." & vbcrlf & vbcrlf &_
"This backup has been cancelled.", 64, "Error in BackupPath "
wscript.quit
end if 'left(BackupPath , len(MyData(p))) = MyData(p)
end if ' not MyData(p) = ""
next 'p

End Sub

'~~[/script]~~

Can anyone show me how to implement a progress bar form into this or point me into the direction where i can find out how to do it?

Your help will be greatly appreciated...

 

[EBGreen]

There are a few ways to do progress bars and they have all been addressed in this forum. At the top of this page, click on the Keywor search tab and enter Progress Bar for the search criteria.

 

[Wantabie]

I was able to find threads about Progress Bars. However, no of them provided any real solutions.

Let me re-iterate my question.

I have a vbscript that makes a backup of files (specified), into another location on a server. The vbscript is quite long and I would like to incorporate a progress form.

Is there not a way to develop a progress form, using Visual Basic or another program and have it open and update when the files are being copied?

 

[EBGreen]

Here is some code for a progress bar:

'---------------------
'
' Filename        justwait.vbs
' Author        Andreas Schneider
'                
' Status        Final 1.0
'
' Prerequisite    Windows Scripting Host
'                IE 6
'
' Abstract        Displays a ping/pong progress bar
'
' History
' 04/07/2003    0.1
'
'---------------------

Option Explicit

'---------------------
'
' global const
'
'---------------------

Const conBarSpeed=80
Const conForcedTimeOut=10000

'---------------------
'
' global vars
'
'---------------------

Dim objIE
Dim objProgressBar 
Dim objTextLine1
Dim objTextLine2 
Dim objQuitFlag


'---------------------
'
' Call Sample Function
'
'---------------------

Sample

'---------------------
'
' Function        Sample
'
' Abstract        Sample Entry Point
'
' Parameters    
'
' Return values    
'
' Revision
'
'---------------------

Public Sub Sample()

    Dim intCount 
    
    StartIE "Ping/Pong Progress Bar"    
        
    SetLine1 "Progress Bar Line 1"
    
    For intCount=1 To 1000
    
        If IsQuit()=True Then
        
            Exit For
        End If
            
        SetLine2 CStr(intCount)
    Next
        
    CloseIE
    
    MsgBox "End of Sample"
    
End Sub

'---------------------
'
' Function        StartIE
'
' Abstract        Launch IE Dialog Box and Progress bar
'
' Parameters    Titel of the box
'
' Return values    
'
' Revision
'
'---------------------


Private Sub StartIE(strTitel)

    Dim objDocument
    Dim objWshShell

    Set objIE = CreateObject("InternetExplorer.Application")

    objIE.height = 230
    objIE.width = 400

    objIE.menubar = False
    objIE.toolbar = false
    objIE.statusbar = false
    objIE.addressbar = false
    objIE.resizable = False

    objIE.navigate ("about:blank")

    ' wait till ie is loaded
    While (objIE.busy)
    wend

    set objDocument = objIE.document 
    
    ' setup the dialog box    
    WriteHtmlToDialog objDocument, strTitel
    
    ' with ie/html loaded, define assorted objects...
    set objTextLine1 = objIE.document.all("txtMilestone")
    set objTextLine2 = objIE.document.all("txtRemarks")
    Set objProgressBar = objIE.document.all("pbText")
    set objQuitFlag = objIE.document.Secret.pubFlag

    objTextLine1.innerTEXT = ""
    objTextLine2.innerTEXT = ""

    ' objIE.document.body.innerHTML = "Building Document..." + "<br>load time= " + n
    objIE.visible = True

    ' set focus to ie 
Set objWSHShell = WScript.CreateObject("WScript.Shell")
    objWshShell.AppActivate("Microsoft Internet Explorer")

End Sub

'---------------------
'
' Function        CloseIE
'
' Abstract        Close the IE Browser Windows
'
' Parameters    
'
' Return values    
'
' Revision
'
'---------------------

Private Function CloseIE()

On Error Resume Next

objIE.quit
End Function 

'---------------------
'
' Function        SetLine1
'
' Abstract        Set Text Line in the Progress Bar Dialog Box
'
' Parameters    Progress Text
'
' Return values    
'
' Revision
'
'---------------------

Private sub SetLine1(sNewText)

On Error Resume Next

objTextLine1.innerTEXT = sNewText
End Sub

'---------------------
'
' Function        SetLine2
'
' Abstract        Set Text Line in the Progress Bar Dialog Box
'
' Parameters    Progress Text
'
' Return values    
'
' Revision
'
'---------------------

Private sub SetLine2(sNewText)

On Error Resume Next

objTextLine2.innerTEXT = sNewText
End Sub


'---------------------
'
' Function        IsQuit
'
' Abstract        Checks if the quit button was pressed
'
' Parameters    Progress Text
'
' Return values    
'
' Revision
'
'---------------------

Private function IsQuit()

On Error Resume Next

IsQuit=True

If objQuitFlag.Value<>"quit" Then

    IsQuit=False
End If

End function

'---------------------
'
' Function        WriteHtmlToDialog
'
' Abstract        Set HTML Text for the IE Dialog box
'
' Parameters    IE Document Object, Title Text
'
' Return values    
'
' Revision
'
'---------------------

Private Sub WriteHtmlToDialog(objDocument, strTitel)

    objDocument.Open

    objDocument.Writeln "<title>" & strTitel & "</title> "

    objDocument.Writeln "<style>"
    objDocument.Writeln " BODY {background: Silver} BODY { overflow:hidden }"
    objDocument.Writeln " P.txtStyle {color: Navy; font-family: Verdana; " _
        & " font-size: 10pt; font-weight: bold; margin-left: 10px } "

    objDocument.Writeln " input.pbStyle {color: Navy; font-family: Wingdings; " _ 
         & " font-size: 10pt; background: Silver; height: 20px; " _
         & " width: 340px } " 
    objDocument.Writeln "</style>"

    objDocument.Writeln "<div id=""objProgress"" class=""Outer""></div>"

    ' write out text lines... 
     objDocument.Writeln "<P id=txtMilestone class='txtStyle' style='margin-left: 10px'> </P>"
    objDocument.Writeln "<P id=txtRemarks class='txtStyle' style='margin-left: 10px' ></P>"
    objDocument.Writeln "<CENTER>"

    ' write progbar
    objDocument.Writeln "<input type='text' id='pbText' class='pbStyle' value='' >" 
    objDocument.Writeln "<br><br>" ' space down a little

    ' write cancel button...
    objDocument.Writeln "<input type='button' value='Cancel' " _
                & " onclick='SetReturnFlag(""quit"")' >"
    objDocument.Writeln "</CENTER>" 

    ' write hidden object...
    objDocument.Writeln "<form name='secret' >" _
                & " <input type='hidden' name='pubFlag' value='run' >" _
                & "</form>" 

    objDocument.Writeln "<SCRIPT LANGUAGE='VBScript' >" 

    ' write "local script" to handle cmdCancel_Click event...
    objDocument.Writeln "Sub SetReturnFlag(sFlag)"
    objDocument.Writeln " secret.pubFlag.Value = sFlag"
    objDocument.Writeln " txtMileStone.style.color = ""Red"" "
    objDocument.Writeln " txtRemarks.style.color = ""Red"" "
    objDocument.Writeln "End Sub" 

    ' progress bar
    objDocument.Writeln "Function PctComplete(nPct)"
    objDocument.Writeln "pbText.Value = String(nPct,"" "") & String(4,""n"")"
    objDocument.Writeln "End Function"

    ' calc progress bar and direction
    objDocument.Writeln "Sub UpdateProgress()"
    objDocument.Writeln "Dim intStep"
    objDocument.Writeln "Dim intDirection"
    
    objDocument.Writeln "If (IsNull(objProgress.getAttribute(""Step"")) = True) Then"
    objDocument.Writeln "intStep = 0"
    objDocument.Writeln "Else"
    objDocument.Writeln "intStep = objProgress.Step"
    objDocument.Writeln "End If"
    
    objDocument.Writeln "if (IsNull(objProgress.GetAttribute(""Direction""))=True) Then"
    objDocument.Writeln "intDirection = 0"
    objDocument.Writeln "Else"
    objDocument.Writeln "intDirection = objProgress.Direction"
    objDocument.Writeln "End If"
    
    objDocument.Writeln "if intDirection=0 then"
    objDocument.Writeln "intStep = intStep + 1"
    objDocument.Writeln "else"
    objDocument.Writeln "intStep = intStep - 1"
    objDocument.Writeln "end if"
    
    objDocument.Writeln "Call PctComplete(intStep)"
    
    objDocument.Writeln "if intStep>=23 then"
    objDocument.Writeln "intDirection=1"
    objDocument.Writeln "end if"
    objDocument.Writeln "if intStep<=0 then"
    objDocument.Writeln "intDirection=0"
    objDocument.Writeln "end if"
    
    objDocument.Writeln "objProgress.SetAttribute ""Step"", intStep"
    objDocument.Writeln "objProgress.SetAttribute ""Direction"", intDirection"
    
    objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
    objDocument.Writeln "End Sub"

    ' timeout function
    objDocument.Writeln "Sub DialogHardTimeout()"
    objDocument.Writeln "SetReturnFlag(""quit"")"
    objDocument.Writeln "End sub"
    
    objDocument.Writeln "Sub Window_OnLoad()"
    objDocument.Writeln "theleft = (screen.availWidth - document.body.clientWidth) / 2"
    objDocument.Writeln "thetop = (screen.availHeight - document.body.clientHeight) / 2"
    objDocument.Writeln "window.moveTo theleft,thetop"
    objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
    objDocument.Writeln "Window.setTimeout GetRef(""DialogHardTimeout""), " & conForcedTimeOut
    objDocument.Writeln "End Sub"
    
    objDocument.Writeln "</SCRIPT>"
     
    objDocument.Close 

End Sub

 

[amorous]

You may want to look a this link:

http://www.atgconsulting.com/progressbar.asp

hope that helps.

VJ

 

[Wantabie]

Thanks for the effort guys,

Tom, i will see if i can implement the code into my script. I will let you know.

Tom maybe you can answer this question: the code is wanting to use IE. I have a program called Script-Debugger IDE, that will let me design a form and use vbscript as the language.

The problem is, i do not know how to pass the variables from one to the other and what variables to pass.

You can get a free demo of Script=Debugger IDE here

http://www.script-debugger.com/download/

Maybe you can figure out to implement this into my script.

Thanks again for your knowledge and suggestions.

I will try to implement your sample caode into this to see if i can get it to work..

 

[PHV]

Why not simply use the standard windows copy animated box, like this ?
srcfile="\path\to\bigfile"
destdir="\\server\share\path\to\dir"
Set SA=CreateObject("Shell.Application")
Set NS=SA.NameSpace(destdir)
NS.CopyHere srcfile,16

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[Wantabie]

Will that be set in a function or sub?

 

[PHV]

In lieu of the CopyFile method

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[Wantabie]

Do you mean something like:
"TheKidd (IS/IT--Manageme) Feb 4, 2004
Dim Network,shell,fso,ParentFolder,objFolder,objShell
Const FOF_CREATEPROGRESSDLG = &H0&
Set Network=WScript.CreateObject("Wscript.Network")
Set fso=WScript.CreateObject("Scripting.FileSystemObject")
Set shell=WScript.CreateObject("Wscript.Shell")
Network.MapNetworkDrive "W:", "\\server1\share$"
ParentFolder="W:\AWBS"
Set objShell=WScript.CreateObject("Wscript.Shell")
set shell=CreateObject("Shell.Application")
set objFolder=shell.NameSpace(ParentFolder)
objFolder.CopyHere "C:\Folder\*.*", FOF_CREATEPROGRESSDLG
Network.RemoveNetworkDrive "W:"
"

Which does not explain how to implement into the original script coding.

 

[Wantabie]

Mapman04 asked it best:
"mapman04 (IS/IT--Manageme) Jan 13, 2003
Is there a way in vb script to visually show the progress of a script? I have a script that copies files to a remote server and would like to see the status of the copying process. Can this be done?"

This is essentially what i am wanting. I do not have any experience with vbscripting. So, i am pretty much taking any suggestions my way. I am backing up files in different locations and putting them into a single location on a remote server. My original thread has the code that i am using. How can i implement a progress bar into it.

 

[dilettante]

See thread329-447025 where I posted a link to "GooeyScript" which is a VB6 ActiveX control that might do what you want.

 

[Wantabie]

That was the ticket. GooeyScript was what i was looking for. I was able to implement it into my original script with ease and now my script looks and acts the way i want it too. Gooeyscript was easy to learn and use. I recommend it to any needing a GUI interface for their vbscripting needs.

Thanks again dilettante and thanks to all for your knowledge and input.