Continious Progress Loop

[kpassaur]

I was looking for help on using a Progress Bar as I have not used one in quite some time. Between what I came accross I put this together for when it cannot be determined when a process will finish.

I used Outlook in this example as almost everyone has it, just change the name to a process you are running.

//This will display a continious running progress bar until an action finishes
//or cancel is pressed at which time it kills the process- it is usefull when there is no way to determine how
//long something will take.

VBSTART
'returns the number of copies of ProcessName that are running
'will return 0 if ProcessName is not running
Function IsProcessRunning(ProcessName)
Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessList = oWMIService.ExecQuery ("Select Name from Win32_Process where Name='" & ProcessName & "'")
IsProcessRunning = colProcessList.count
End Function

Sub killProcess(pgm)
set wmi = getobject("winmgmts:")
sQuery = "select * from win32_process " & "where name='" & pgm & "'"
set processes = wmi.execquery(sQuery)
for each process in processes
process.terminate
next
End Sub
VBEND

Dialog>dlgProgress
Caption=File Retrieval
Width=297
Height=194
Top=CENTER
Left=CENTER
Max=0
Min=0
Close=1
Resize=0
Label=Please Wait,80,20,true
Label=___________________________________________________________________________________,0,30,true
ProgressBar=ProgressBar,11,87,266,17,0
Label=Files being Assembled,92,64,true
Button=Cancel,202,123,75,25,2
Default=Continue
EndDialog>dlgProgress


SetDialogObjectFont>dlgProgress,MSLABEL1,Gotthard,12,0,0
SetDialogObjectFont>dlgProgress,MSLABEL2,Arial,20,1,15633459





/// Activate process and send to subroutine in this example Outlook will be the process
///so change Outlook to the process you are running

GoSub>Showprogress


SRT>Showprogress
Show>dlgProgress
Let>k=1
Label>repeatloop
VBEval>IsProcessRunning("outlook.exe"),res
If>res>0
GetDialogAction>dlgProgress,quitassemble
If>quitassemble=2
Goto>killitall
Endif
ResetDialogAction>dlgProgress
Let>dlgProgress.progressbar=k
Wait>0.1
Let>k=k+1
If>k=100
Let>k=1
Endif
Else
Goto>doneprogress

Endif
Goto>repeatloop
Label>doneprogress
END>Showprogress

Label>killitall
VBRun>KillProcess,outlook.exe
Exit>0

[migro]

Hi kpassaur,

want to thank you for this nice sample. It gives me the right ideas how to configure progressbars when a other process is startet by the macro and cannot be determined when its finished.