Option Explicit
'As this is originally designed for vb script (as you can use a userform progress bar
' in VBA/VB), the variables are not dimensioned as any specific type. If you will only
' be using this in VB/VBA, then you can use the following dimension statements:
' Dim IE As Object, vHead As Object, vBar As Object, IEOpen As Boolean
' Dim progr As Long, totl As Long, i As Long
'
'If you do this, you will have to remove the "Set ___ = Nothing" lines for the
' non-object variables at the bottom of the subroutine.
'
' Also, you can use the following function declaration lines instead of those below:
' Function SetProgText(ByVal vDocumentObject As Object, ByVal vObjectText As String, _
' ByRef IEOpen As Boolean) As Boolean
' Function StartIE(ByRef IE As Object) As Boolean
'(again, remove the Set vObjectText = Nothing as it isn't an object/variant)
'
'For formatting purposes, I put the body of the subroutine in a Sub/End Sub block,
' but as noted, if you're using in VBS then you can remove these
Sub IEProgressExample() 'comment this line out if using in vbscript
Dim IE, vHead, vBar, i, progr, totl, IEOpen
'Initialize IE, set variables and initial heading
StartIE IE
Set vHead = IE.Document.All("vHead")
Set vBar = IE.Document.All("vBar")
IEOpen = True
'This is how you set the text to the different parts of the progress window
SetProgText vHead, "Working...", IEOpen
'example for loop to increment progress counter
totl = 2500
For i = 1 To totl
progr = CLng((i / (totl)) * 100)
SetProgText vBar, String(progr, "|") & String(100 - progr, "."), IEOpen
Next 'i
'clear variables
If IEOpen Then IE.Quit
Set IE = Nothing
Set vHead = Nothing
Set vBar = Nothing
Set IEOpen = Nothing
Set i = Nothing
Set progr = Nothing
Set totl = Nothing
End Sub 'comment this line out if using in vbscript
Function SetProgText(ByVal vDocumentObject, ByVal vObjectText, ByRef IEOpen)
If Not IEOpen Then Exit Function
On Error Resume Next
vDocumentObject.InnerHTML = vObjectText
If Err.Number <> 0 Then IEOpen = False
Set vObjectText = Nothing
Set vDocumentObject = Nothing
End Function
Function StartIE(ByRef IE)
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate2 "about:blank"
Do While .readyState <> 4
Loop
.Document.Title = "Progress"
.Document.Body.InnerHTML = _
"<BODY SCROLL='NO'><CENTER><FONT FACE='arial black' SIZE=2>" & vbLf & _
"<DIV id='vHead' ALIGN='Left'></DIV>" & vbLf & _
"<DIV id='vBar' ALIGN='Left'></DIV>" & vbLf & _
"</FONT></CENTER></BODY>"
.Document.Body.Scroll = "no"
.Toolbar = False
.StatusBar = False
.Resizable = False
.Width = 435
.Height = 100
.Left = 0
.Top = 0
.Visible = True
End With
End Function
|