• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1840
  • Last Modified:

How to put a progress bar into a vbscript to show progress??

i have a vbscript that i use to backup a profile and i was wondering how i would put in a progress bar into the script to show what is going on in the backup.

i can post the script if need be
0
amoos
Asked:
amoos
  • 7
  • 4
1 Solution
 
amoosAuthor Commented:
great link.  very helpful, but where in my script do i put this code in???  the code from the link is below and then my script is below that.  great help.

On Error Resume Next

strComputer = "."
Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
For Each objItem in colItems
    intHorizontal = objItem.ScreenWidth
    intVertical = objItem.ScreenHeight
Next

Set objExplorer = CreateObject _
    ("InternetExplorer.Application")

objExplorer.Navigate "about:blank"  
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Left = (intHorizontal - 400) / 2
objExplorer.Top = (intVertical - 200) / 2
objExplorer.Width = 400
objExplorer.Height = 200
objExplorer.Visible = 1            

objExplorer.Document.Body.Style.Cursor = "wait"

objExplorer.Document.Title = "Logon script in progress"
objExplorer.Document.Body.InnerHTML = "Your logon script is being processed. " _
    & "This might take several minutes to complete."

Wscript.Sleep 10000

objExplorer.Document.Body.InnerHTML = "Your logon script is now complete."

objExplorer.Document.Body.Style.Cursor = "default"

Wscript.Sleep 5000

objExplorer.Quit

the script i am using is below, where do i put in the progress bar code in the vbscript below??

'The Dominican Campus Backup script
'Backup's select components of the user's profile to a dated folder on an external hard drive
'Created 02.10.09

'Declarations
Set fso = WScript.CreateObject("Scripting.FileSystemObject") 'Standard File System Object
Set WshNetwork = WScript.CreateObject("WScript.Network")  'Standard Network Object
strUser = WshNetwork.UserName 'Pulls User Name, used to find user's profile folder
BackupDriveLetter = "E"   'The Drive Letter the Backup Hard Drive is set to.
'Asks to start the backup
X=MsgBox("Are You Ready To Create A Profile Backup On Todays Date Which Is " & Date & " ?",36,"The Dominican Campus Profile Backup Script")
If X = 6 Then 'If MsgBox is answered YES
 X=MsgBox("Please Make Sure Your External Hard Drive Is Plugged In And Set To Drive Letter " & BackupDriveLetter & ":",48,"The Dominican Campus Profile Backup Script")
 StartBackup() 'Start main Subroutine
Else
 WScript.Quit 'If MsgBox is answered NO
End If
'Main Program
Sub StartBackup()
 'Check for Backup Drive
 If (Not fso.DriveExists(BackupDriveLetter)) Then
     X=MsgBox("I Can't find Your External Hard Drive On " & BackupDriveLetter & ":!" & vbCrLf &  "Please Make Sure Your External Hard Drive Is Plugged In And The Drive Letter Is Set To " & BackupDriveLetter & ":!",16,"Backup Error")
     WScript.Quit
 End If
 'Check free space on Backup Drive
 Set BackupDrive = fso.GetDrive(BackupDriveLetter)    
 EFreeSpace = CDbl(FormatNumber(BackupDrive.FreeSpace/1024/1024,2)) 'Polls for free space on BackupDrive
 'Check how much room backup will need
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Desktop")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\My Documents")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Favorites")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Local Settings\Application Data\Microsoft\Outlook")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Application Data\Microsoft\Outlook")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 'See if there is enough free space on Backup Drive for the backup.
 If SpaceNeeded >= EFreeSpace Then        'If there isn't enough free space then...
     Set objFolder = FSO.GetFolder(BackupDriveLetter & ":\")  'Get the BackupDrive
     Set colFolders = objFolder.SubFolders      'Get the Subfolders on BackupDrive
     For Each objSubFolder In colFolders       'For each subfolder.....
         If Left(objSubFolder.Name,1) = "B" Then     'Check if the folder starts with a "B", this is to prevent deletion of non-backup folders.
              If FTDName = "" Then FTDName = objSubFolder.Name 'Get Subfolder name if variables empty (first run)
              If FTDDate = "" Then FTDDate =  objSubFolder.DateCreated 'Get subfolder date  if variables empty (first run)
              If FTDDateDiff = "" Then FTDDateDiff = DateDiff("s", Now, objSubFolder.DateCreated)  'Gets the difference in seconds between NOW and the folder's timestamp
              If FTDDateDiff > DateDiff("s", Now, objSubFolder.DateCreated) Then 'If the DateDifference for the previous folder is greater (newer) than the current folder...
                 FTDName = objSubFolder.Name      'Record a new folder name
                 FTDDate = objSubFolder.DateCreated    'Record a new folder Date
                 FTDDateDiff = DateDiff("s", Now, objSubFolder.DateCreated) 'Record a new folder DateDifference
              End If  
         End If
     Next
         X=MsgBox("I Am Terribly Sorry There Is Not Enough Room On Your External Hard Drive! Please Free Up Some Space For Me" & VbCrLf & "Backup Size: " & SpaceNeeded & "MB       Free Space Available: " & EFreeSpace & "MB" & VbCrLf &"The oldest backup found is * " & FTDName & " * created on " & FTDDate & VbCrLf & "Delete this backup and start new backup?",36,"Backup Error")
     If X = 6 Then 'If MsgBox is answered YES
         FSO.DeleteFolder(BackupDriveLetter & ":\" & FTDName)
         StartBackup()
         WScript.quit
     Else 'If MsgBox is answered NO
         X=MsgBox("Sorry Please Free Up Some Space Manually And Run The Backup again",16,"Backup Error")
         WScript.quit
     End If
 End If
 X=MsgBox("I Am Ready To Backup Your Profile Now " & SpaceNeeded & "MB of data." & VbCrLf & "Please Click OK If You Are Ready For Me To Backup Your Profile Then WAIT Until You Get A Profile Backup Is Complete Message.",48,"I Am Now Backing Up Your Profile Please Wait Because If You Have An Enormous Amount Of Data This Could Take Awhile")
 'If there's enough free space, backup files
 TodaysDate = ("Backed Up Profile On " & Month(Now) & "." & Day(Now) & "." & Year(Now) & " " & "At " & Hour(Now) & " " & Minute(Now) & " " & Second(Now)) 'Get Unique folder name for backup with a timestamp
 TodaysDate = TodaysDate & "_" & strUser
 FSO.CreateFolder(BackupDriveLetter & ":\" & TodaysDate)             'Create Unique folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Desktop" , BackupDriveLetter & ":\" & TodaysDate & "\Desktop" , True 'Copy user's Desktop folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\My Documents" , BackupDriveLetter & ":\" & TodaysDate & "\My Documents" , True 'Copy user's My Documents folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Favorites" , BackupDriveLetter & ":\" & TodaysDate & "\Favorites" , True 'Copy user's Favorites folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Local Settings\Application Data\Microsoft\Outlook" , BackupDriveLetter & ":\" & TodaysDate & "\Outlook", True 'Copy user's Outlook folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Application Data\Microsoft\Outlook" , BackupDriveLetter & ":\" & TodaysDate & "\Outlook", True 'Copy another user's Outlook folder
 X=MsgBox("Finally I Am Done backing up Your Profile And Here Is The Amount Of Data I Backed Up For You "& SpaceNeeded & "MB of data to folder "& BackupDriveLetter & ":\"& TodaysDate,64,"Your Profile Backup Is Complete Please Have A Wonderful Day")
End Sub

0
 
yehudahaCommented:
lets leave your code

save the code from the link as a vbs file
then in your code put this lines in the point you want to call the other script(progressbar)

change to the path you saving the file here:
strcommandline = """C:\Documents and Settings\ys\Desktop\progressbar.vbs"""
Set objShell = CreateObject("WScript.Shell") 
strcommandline = """C:\Documents and Settings\ys\Desktop\progressbar.vbs"""
objShell.Run(strcommandline)

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
yehudahaCommented:
change as need to the right value of time taking the script to back up before the finish message apper

Wscript.Sleep 10000

or just remove this lines to use just the script is running mesage

objExplorer.Document.Body.InnerHTML = "Your logon script is now complete."

Wscript.Sleep 5000
0
 
amoosAuthor Commented:
that code you gave me worked great but the progress bar closes before the script is even finished.  how do i get it to time right so that it shows the progress of everything being backed up??  great help
0
 
amoosAuthor Commented:
how would i know what timing value to use.  for example if i am backing up a profile that is 6GB then what would be the timing for that??  or lets say i move to the next person and their's is only 3GB.  is there a way that i can write into the script to do what windows does with the progress when you are copying file from one place to another??  awesome help
0
 
yehudahaCommented:
no we can do it like windows we are not .net developers  :-)

i splited the progress bar to 2 subs

and called them here:

 startbar() ' show script in progress
 StartBackup() 'Start main Subroutine
 endbar() ' ending message

if you want to change it just use :  startbar()  and endbar()
'The Dominican Campus Backup script
'Backup's select components of the user's profile to a dated folder on an external hard drive
'Created 02.10.09
 
'Declarations
Set fso = WScript.CreateObject("Scripting.FileSystemObject") 'Standard File System Object
Set WshNetwork = WScript.CreateObject("WScript.Network")  'Standard Network Object
strUser = WshNetwork.UserName 'Pulls User Name, used to find user's profile folder
BackupDriveLetter = "E"   'The Drive Letter the Backup Hard Drive is set to.
'Asks to start the backup
X=MsgBox("Are You Ready To Create A Profile Backup On Todays Date Which Is " & Date & " ?",36,"The Dominican Campus Profile Backup Script")
If X = 6 Then 'If MsgBox is answered YES
 X=MsgBox("Please Make Sure Your External Hard Drive Is Plugged In And Set To Drive Letter " & BackupDriveLetter & ":",48,"The Dominican Campus Profile Backup Script")
 startbar()
 StartBackup() 'Start main Subroutine
 endbar()
Else
 WScript.Quit 'If MsgBox is answered NO
End If
 
 
 
'Main Program
Sub StartBackup()
 'Check for Backup Drive
 If (Not fso.DriveExists(BackupDriveLetter)) Then
     X=MsgBox("I Can't find Your External Hard Drive On " & BackupDriveLetter & ":!" & vbCrLf &  "Please Make Sure Your External Hard Drive Is Plugged In And The Drive Letter Is Set To " & BackupDriveLetter & ":!",16,"Backup Error")
     WScript.Quit
 End If
 'Check free space on Backup Drive
 Set BackupDrive = fso.GetDrive(BackupDriveLetter)    
 EFreeSpace = CDbl(FormatNumber(BackupDrive.FreeSpace/1024/1024,2)) 'Polls for free space on BackupDrive
 'Check how much room backup will need
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Desktop")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\My Documents")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Favorites")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Local Settings\Application Data\Microsoft\Outlook")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 Set objFolder = FSO.GetFolder("C:\Documents and Settings\" & strUser & "\Application Data\Microsoft\Outlook")
 SpaceNeeded = SpaceNeeded + CDbl(FormatNumber((objFolder.Size/1024/1024),2)) 'Polls folder size, then adds it to total SpaceNeeded
 'See if there is enough free space on Backup Drive for the backup.
 If SpaceNeeded >= EFreeSpace Then        'If there isn't enough free space then...
     Set objFolder = FSO.GetFolder(BackupDriveLetter & ":\")  'Get the BackupDrive
     Set colFolders = objFolder.SubFolders      'Get the Subfolders on BackupDrive
     For Each objSubFolder In colFolders       'For each subfolder.....
         If Left(objSubFolder.Name,1) = "B" Then     'Check if the folder starts with a "B", this is to prevent deletion of non-backup folders.
              If FTDName = "" Then FTDName = objSubFolder.Name 'Get Subfolder name if variables empty (first run)
              If FTDDate = "" Then FTDDate =  objSubFolder.DateCreated 'Get subfolder date  if variables empty (first run)
              If FTDDateDiff = "" Then FTDDateDiff = DateDiff("s", Now, objSubFolder.DateCreated)  'Gets the difference in seconds between NOW and the folder's timestamp
              If FTDDateDiff > DateDiff("s", Now, objSubFolder.DateCreated) Then 'If the DateDifference for the previous folder is greater (newer) than the current folder...
                 FTDName = objSubFolder.Name      'Record a new folder name
                 FTDDate = objSubFolder.DateCreated    'Record a new folder Date
                 FTDDateDiff = DateDiff("s", Now, objSubFolder.DateCreated) 'Record a new folder DateDifference
              End If  
         End If
     Next
         X=MsgBox("I Am Terribly Sorry There Is Not Enough Room On Your External Hard Drive! Please Free Up Some Space For Me" & VbCrLf & "Backup Size: " & SpaceNeeded & "MB       Free Space Available: " & EFreeSpace & "MB" & VbCrLf &"The oldest backup found is * " & FTDName & " * created on " & FTDDate & VbCrLf & "Delete this backup and start new backup?",36,"Backup Error")
     If X = 6 Then 'If MsgBox is answered YES
         FSO.DeleteFolder(BackupDriveLetter & ":\" & FTDName)
         StartBackup()
         WScript.quit
     Else 'If MsgBox is answered NO
         X=MsgBox("Sorry Please Free Up Some Space Manually And Run The Backup again",16,"Backup Error")
         WScript.quit
     End If
 End If
 X=MsgBox("I Am Ready To Backup Your Profile Now " & SpaceNeeded & "MB of data." & VbCrLf & "Please Click OK If You Are Ready For Me To Backup Your Profile Then WAIT Until You Get A Profile Backup Is Complete Message.",48,"I Am Now Backing Up Your Profile Please Wait Because If You Have An Enormous Amount Of Data This Could Take Awhile")
 'If there's enough free space, backup files
 TodaysDate = ("Backed Up Profile On " & Month(Now) & "." & Day(Now) & "." & Year(Now) & " " & "At " & Hour(Now) & " " & Minute(Now) & " " & Second(Now)) 'Get Unique folder name for backup with a timestamp
 TodaysDate = TodaysDate & "_" & strUser
 FSO.CreateFolder(BackupDriveLetter & ":\" & TodaysDate)             'Create Unique folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Desktop" , BackupDriveLetter & ":\" & TodaysDate & "\Desktop" , True 'Copy user's Desktop folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\My Documents" , BackupDriveLetter & ":\" & TodaysDate & "\My Documents" , True 'Copy user's My Documents folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Favorites" , BackupDriveLetter & ":\" & TodaysDate & "\Favorites" , True 'Copy user's Favorites folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Local Settings\Application Data\Microsoft\Outlook" , BackupDriveLetter & ":\" & TodaysDate & "\Outlook", True 'Copy user's Outlook folder
 FSO.CopyFolder "C:\Documents and Settings\" & strUser & "\Application Data\Microsoft\Outlook" , BackupDriveLetter & ":\" & TodaysDate & "\Outlook", True 'Copy another user's Outlook folder
 X=MsgBox("Finally I Am Done backing up Your Profile And Here Is The Amount Of Data I Backed Up For You "& SpaceNeeded & "MB of data to folder "& BackupDriveLetter & ":\"& TodaysDate,64,"Your Profile Backup Is Complete Please Have A Wonderful Day")
End Sub
 
Sub startbar()
On Error Resume Next
 
strComputer = "."
Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
For Each objItem in colItems
    intHorizontal = objItem.ScreenWidth
    intVertical = objItem.ScreenHeight
Next
 
Set objExplorer = CreateObject _
    ("InternetExplorer.Application")
 
objExplorer.Navigate "about:blank"   
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Left = (intHorizontal - 400) / 2
objExplorer.Top = (intVertical - 200) / 2
objExplorer.Width = 400
objExplorer.Height = 200 
objExplorer.Visible = 1             
 
objExplorer.Document.Body.Style.Cursor = "wait"
 
objExplorer.Document.Title = "Logon script in progress"
objExplorer.Document.Body.InnerHTML = "Your logon script is being processed. " _
    & "This might take several minutes to complete."
End Sub
 
Sub endbar()
objExplorer.Document.Body.InnerHTML = "Your logon script is now complete."
 
objExplorer.Document.Body.Style.Cursor = "default"
 
Wscript.Sleep 5000
 
objExplorer.Quit
End Sub

Open in new window

0
 
yehudahaCommented:
messed it don't use it
0
 
yehudahaCommented:
i think you need to use what  i posted call another script and
just remove this lines to use just the script is running mesage

objExplorer.Document.Body.InnerHTML = "Your logon script is now complete."

Wscript.Sleep 5000

0
 
amoosAuthor Commented:
awesome help thank you.
0
 
yehudahaCommented:
thanks
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now