VB Script progress bar not closing on a 64bit OS Worked fine on XP and 2000 System

Hi,

I have this cleanup vbscript with progress bar that I got from here which was working in the older systems. Now I have switched to a 64 bit Windows 7 system and the progess bar opens instances of the progress bar but does not close it. Can anyone please fix this.

Script from Chris Bottomley

srcDir="C:\log\"
destDir="D:\log\"
If Right(srcdir, 1) <> "\" Then srcdir = srcdir & "\"
If Right(destdir, 1) <> "\" Then destdir = destdir & "\"

Set fso=CreateObject("Scripting.FileSystemObject")
Set sh=WScript.CreateObject("WScript.Shell")

FileSet = GetDirContents(srcDir) 
intFile = 0
intFiles = ubound(fileset) + 1
'Dim objDoc 'Required global declaration for status bar document
'Dim objIE 'Required global declaration for Internet Explorer object

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
'wscript.echo inthorizontal & " : " & intvertical
Next


strTitle = "Status-Bar"

For each File in FileSet 
	intfile = intfile + 1
	x = cint(intfile / intfiles * 100)
	msg = "File " & intfile & " of " & intFiles & vbCrLf
	Set File = fso.GetFile(srcdir & File)
	statusBar x, msg
	WScript.Sleep 10
 	Date1 = File.DateLastModified 
	Date2 = Now()
	'DDiff = Abs(DateDiff("h", Date1, Date2))
	DDiff = Abs(DateDiff("d", Date1, Date2))

    If DDiff >= 60 Then
      If Not fso.FileExists(DestPath & File.Name) Then
        File.Move DestDir 
                'wscript.echo File.Name
      Else
        wscript.echo "Unable to move file [" & File.Name & "].  A file by this name already exists in the target directory."
      End If
    End If
Next 

WScript.Sleep 1000
statusBar -1, ""
Set objDoc = Nothing
Set objIE = Nothing
''MsgBox "File move complete"


Function statusBar(intPercent, strTitle)
'intPercent is limited to the range 0 ... 100. 
'If intPercent is out of range, then the window is suppressed for those values 

	'Create the status bar window
	    on Error resume next
            If objDoc Is Nothing Then
		If ((Cint(intPercent) >= 0) And (Cint(intPercent) <= 100)) Then
			Set objIE = CreateObject("InternetExplorer.Application")
			objIE.Offline = True
			objIE.AddressBar = False
			objIE.Height = 100
                        objIE.top = cint((intvertical - objie.height)/2)
			objIE.width = 250
                        objIE.left = cint((inthorizontal - objie.width)/2)
			objIE.Width = 250
                        objIE.left = 300
			objIE.MenuBar = False
			objIE.StatusBar = False
			objIE.Silent = false 'True
			objIE.ToolBar = False
			objIE.Navigate "about:blank"
			Do While objIE.Busy
				WScript.Sleep 100
			Loop
			'On Error Resume Next
			Set objDoc = Nothing
			Do Until Not objDoc Is Nothing
				WScript.Sleep 100
				Set objDoc = objIE.Document
			Loop
			objDoc.Open
			objDoc.Write "<html><head><title>" & strTitle & "</title></head>"
			  objDoc.Write "<body><center>"
			    objDoc.Write "<TABLE width=200 border=3 >"
			      objDoc.Write "<tr><td>"
			        objDoc.Write "<TABLE id=status width=0 border=0 cellpadding=0 cellspacing=0 bgcolor=#FFFFFF>"
			          objDoc.Write "<tr><td>&nbsp</td></tr>"
			        objDoc.Write "</table>"
	                      objDoc.Write "</td></tr>"
                            objDoc.Write "</TABLE>"
			objDoc.Write "</body>"
	                objDoc.Write "</html>"
		        objDoc.Close
		        objIE.Visible = True
		Else
			Exit Function
		End If
	End If

	'Close the status bar window
	If Not objDoc Is Nothing Then
		If ((Cint(intPercent) < 0) Or (Cint(intPercent) > 100)) Then
			objIE.Visible = False
			Set objDoc = Nothing
			objIE.Quit
			Set objIE = Nothing
			Exit Function
		End If
	End If

	'Update the status bar window
	If Cint(intPercent) = 0 Then
		objDoc.all.status.width = "0%"
		objDoc.all.status.bgcolor = "#FFFFFF"
	Else
		objDoc.all.status.width = Cstr(Cint(intPercent)) & "%"
		objDoc.all.status.bgcolor = "#00CCFF"
	End If

'    for each ie in createobject("shell.application").windows
'        if instr(lcase(typename(ie.document)),"htmldocument") <> 0 then
'            if ie.document.title = strTitle then
'                ie.visible = true
'                .appactivate ie
'            end if
'        end if
'    next

End Function




Function GetDirContents(FolderPath) 
 Dim  FileCollection, aTmp(), i 
 Set fso = CreateObject("Scripting.FileSystemObject") 
 Set FileCollection = fso.GetFolder(FolderPath).Files 

  Redim aTmp(FileCollection.count - 1) 
  i = -1 

    For Each File in FileCollection 
       i = i + 1 
       aTmp(i) = File.Name 
    Next 

  GetDirContents = aTmp 
End Function

Open in new window

Thanks,
Vicki
Vicki05Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

zalazarCommented:
Can you please change:
'Dim objDoc 'Required global declaration for status bar document
'Dim objIE 'Required global declaration for Internet Explorer object

Open in new window

to:
Dim objDoc  'Required global declaration for status bar document
Dim objIE   'Required global declaration for Internet Explorer object
Set objIE = CreateObject("InternetExplorer.Application")

Open in new window

And after line:
If ((Cint(intPercent) >= 0) And (Cint(intPercent) <= 100)) Then

Open in new window

remove the following line completely:
Set objIE = CreateObject("InternetExplorer.Application")

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Vicki05Author Commented:
Thanks Zalazar,

I will try it out.
Vicki05Author Commented:
I tried using the script, it works in windows 7 but now will not properly work on Windows 2000 system. I would like to be able to run on 2000, xp and windows 7.
zalazarCommented:
Wouldn't it be possible to use 2 separate versions ?
Vicki05Author Commented:
Thanks I will try that.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.