Make my code wait until cursor is loading MS Excel 2016 - excel

I am doing some automation work to do repeated copy paste work. Sometimes the server will be so slow. In that time i would be using the below code to wait until the cursor wait goes to normal
Option Explicit
Private Const IDC_WAIT As Long = 32514
Private Type POINT
x As Long
y As Long
End Type
Private Type CURSORINFO
cbSize As Long
flags As Long
hCursor As Long
ptScreenPos As POINT
End Type
Private Declare Function GetCursorInfo _
Lib "user32" (ByRef pci As CURSORINFO) As Boolean
Private Declare Function LoadCursor _
Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Public Function IsWaitCursor() As Boolean
' Get handle to wait cursor
Dim handleWaitCursor As Long
handleWaitCursor = LoadCursor(ByVal 0&, IDC_WAIT)
Dim pci As CURSORINFO
pci.cbSize = Len(pci)
' Retrieve information about the current cursor
Dim ret As Boolean
ret = GetCursorInfo(pci)
If ret = False Then
MsgBox "GetCursorInfo failed", vbCritical
Exit Function
End If
' Returns true when current cursor equals to wait cursor
IsWaitCursor = (pci.hCursor = handleWaitCursor)
End Function
The above code worked fine for me in MS Excel 2013 32-bit. But now I am using MS Excel 64-bit and the above code is not working. Someone please tell me what needs to be done

Private Const IDC_WAIT As Long = 32514
Private Type POINT
X As Long
Y As Long
End Type
Private Type CURSORINFO
cbSize As Long
flags As Long
hCursor As LongPtr
ptScreenPos As POINT
End Type
Private Declare PtrSafe Function GetCursorInfo _
Lib "User32" (ByRef pci As CURSORINFO) As Boolean
Private Declare PtrSafe Function LoadCursor Lib "User32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As LongPtr
Public Function IsWaitCursor() As Boolean
' Get handle to wait cursor
Dim handleWaitCursor As LongPtr
handleWaitCursor = LoadCursor(ByVal 0&, IDC_WAIT)
Dim pci As CURSORINFO
pci.cbSize = Len(pci)
' Retrieve information about the current cursor
Dim ret As Boolean
ret = GetCursorInfo(pci)
If ret = False Then
MsgBox "GetCursorInfo failed", vbCritical
Exit Function
End If
' Returns true when current cursor equals to wait cursor
IsWaitCursor = (pci.hCursor = handleWaitCursor)
End Function
The above code worked for me. I changed the Long datatype to LongPtr

Related

Hand Cursor for Label vba excel

I'm developing an application with many controls. I want to change the mouse cursor when it passes over a Label. I took a look in the option but there you have a limited choice and not what I want. I tried also to upload a mouse icon but I faced two difficulties: the first one is finding an icon under license cc0 and the second one is that Excel doesn't accept the format that I found. Can you please help? Thanks in advance
You can use the Windows API to change the cursor appearance. I'm assuming this is in an Excel UserForm, so you can use the MouseMove event to know when the mouse is over the label.
Here's the code that you would add in the code behind in a form.
Option Explicit
'Api Declarations
Private Declare Function GetCursorInfo Lib "user32" (ByRef pci As CursorInfo) As Boolean
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'You can use the default cursors in windows
Public Enum CursorTypes
IDC_ARROW = 32512
IDC_IBEAM = 32513
IDC_WAIT = 32514
IDC_CROSS = 32515
IDC_UPARROW = 32516
IDC_SIZE = 32640
IDC_ICON = 32641
IDC_SIZENWSE = 32642
IDC_SIZENESW = 32643
IDC_SIZEWE = 32644
IDC_SIZENS = 32645
IDC_SIZEALL = 32646
IDC_NO = 32648
IDC_HAND = 32649
IDC_APPSTARTING = 32650
End Enum
'Needed for GetCursorInfo
Private Type POINT
X As Long
Y As Long
End Type
'Needed for GetCursorInfo
Private Type CursorInfo
cbSize As Long
flags As Long
hCursor As Long
ptScreenPos As POINT
End Type
'Event that handles knowing when the mouse is over the control
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
AddCursor IDC_HAND
End Sub
'To set a cursor
Private Function AddCursor(CursorType As CursorTypes)
If Not IsCursorType(CursorType) Then
SetCursor LoadCursor(0, CursorType)
Sleep 200 ' wait a bit, needed for rendering
End If
End Function
'To determine if the cursor is already set
Private Function IsCursorType(CursorType As CursorTypes) As Boolean
Dim CursorHandle As Long: CursorHandle = LoadCursor(ByVal 0&, CursorType)
Dim Cursor As CursorInfo: Cursor.cbSize = Len(Cursor)
Dim CursorInfo As Boolean: CursorInfo = GetCursorInfo(Cursor)
If Not CursorInfo Then
IsCursorType = False
Exit Function
End If
IsCursorType = (Cursor.hCursor = CursorHandle)
End Function

Focus to MgsBox when Excel is not active

I have checked related questions such as this or this one but the solutions there do not seem to solve my problem.
I am running a VBA script on my computer. The script takes a few minutes to execute and while waiting I am checking other things in my computer. To get my attention once the script has finished running, I have included a MsgBox at the end of my script. However, because Excel is not active/selected when the script finishes, I cannot see it - only when I reactivate/select Excel.
How can I bring into focus the MsgBox when Excel is not active? I have already tried the following tweaks but they do not work:
ThisWorkbook.Activate:
...
ThisWorkbook.Activate
MsgBox "..."
...
AppActivate() (this command threw an error):
...
AppActivate("Microsoft excel")
MsgBox "..."
...
How about playing a sound when the program finishes?
Place this declaration at the top of a standard code module, above any procedures existing there.
Public Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, _
ByVal dwDuration As Long) As Long
If you place this procedure in the same module you may not need it to be public. Adjust pitch and duration to your preference.
Sub EndSound()
Beep 500, 1000
End Sub
Then place the procedure call at the end of your program.
Call EndSound
I suppose you might use a more elaborate sound - may I suggest a couple of bars from Beethoven's 5th? Modify the EndSound procedure. Chip Pearson has more on this idea.
Try:
Application.WindowState = xlMaximized
Disclaimer: This is not my code and I do not know who the author is. I had this code in my database.
Put your code in Sub Sample(). I have shown where you can insert your code. Once the code is run, Excel will flash 5 times. you can change this number by changing Private Const NumberOfFlashes = 5
Paste this in a Module.
Option Explicit
Private Type FLASHWINFO
cbSize As Long
Hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long
End Type
Private Const FLASHW_STOP As Long = 0
Private Const FLASHW_CAPTION As Long = &H1
Private Const FLASHW_TRAY As Long = &H2
Private Const FLASHW_ALL As Long = (FLASHW_CAPTION Or FLASHW_TRAY)
Private Const FLASHW_TIMER As Long = &H4
Private Const FLASHW_TIMERNOFG As Long = &HC
Private FLASHW_FLAGS As Long
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function FlashWindowEx Lib "user32" _
(FWInfo As FLASHWINFO) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const NumberOfFlashes = 5
Private Function APIFunctionPresent(ByVal FunctionName _
As String, ByVal DllName As String) As Boolean
Dim lHandle As Long
Dim lAddr As Long
lHandle = LoadLibrary(DllName)
If lHandle <> 0 Then
lAddr = GetProcAddress(lHandle, FunctionName)
FreeLibrary lHandle
End If
APIFunctionPresent = (lAddr <> 0)
End Function
Sub Sample()
'
' Put your code here. Once that code finishes, Excel will FLASH
'
Dim udtFWInfo As FLASHWINFO
If Not APIFunctionPresent("FlashWindowEx", "user32") Then Exit Sub
With udtFWInfo
.cbSize = Len(udtFWInfo)
.Hwnd = Application.Hwnd
.dwFlags = FLASHW_FLAGS Or FLASHW_TRAY
.uCount = NumberOfFlashes
.dwTimeout = 0
End With
Call FlashWindowEx(udtFWInfo)
MsgBox "Done"
End Sub
The easiest way is to probably to create a userform instead then set the focus to this when it initialises.
Code in the userform to show as modal:
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _
As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Sub UserForm_Initialize()
Dim hwnd As Long: hwnd = FindWindow(vbNullString, Me.Caption)
If hwnd > 0 Then SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS ' Set Modal
End Sub

CTD in Excel VBA

My macro is causing excel to crash to desktop with no debug or error message, the whole application shuts down, closing any open instances of excel.
The code that I've written so far is pretty light, so I have no idea what is causing the crash.
The crash appears to occur after StartGame() has finished. I assume it's being caused by the Timer which runs Main() every 50ms as the CTD exclusively happens after End Sub in StartGame().
I've included all the code below.
Main Module
Option Explicit
Public Sub StartGame()
InitialiseGame
InitialiseTimer
GameRunning = True
End Sub
Public Sub Main()
If GameInput.TabIsPressed Then TerminateTimer
If Not GameRunning Then Exit Sub
Graphics.DrawSquare
End Sub
Private Sub InitialiseGame()
Set GameInput = New ClassGameInput
Set Graphics = New ClassGraphics
Set Square = New ClassSquare
End Sub
Timer Module
Option Explicit
Private Const MILLISECONDS_IN_SECOND As Integer = 1000
Private Const GAME_TICKS_PER_SECOND As Integer = 20
Private GameTimerID As Long
Public Sub InitialiseTimer()
Dim GameTimerInterval As Double
GameTimerInterval = MILLISECONDS_IN_SECOND / GAME_TICKS_PER_SECOND
Sleep (500)
GameTimerID = SetTimer(0, 0, GameTimerInterval, AddressOf Main)
End Sub
Public Sub TerminateTimer()
If GameTimerID <> 0 Then
KillTimer 0, GameTimerID
GameTimerID = 0
GameRunning = False
End If
Set GameInput = Nothing
Set Graphics = Nothing
Set Square = Nothing
End Sub
Public Declarations Module
Option Explicit
#If Win64 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If
Public Const BORDER_START_X As Integer = 4
Public Const BORDER_START_Y As Integer = 4
Public Const BORDER_END_X As Integer = 185
Public Const BORDER_END_Y As Integer = 73
Public Const SQUARE_SIZE As Integer = 10
Public Const SQUARE_COLOUR As Long = rgbLightBlue
Public GameRunning As Boolean
Public GameInput As ClassGameInput
Public Graphics As ClassGraphics
Public Square As ClassSquare
Class GameInput
Option Explicit
Public Function UpIsPressed() As Boolean
UpIsPressed = (GetAsyncKeyState(vbKeyUp) <> 0)
End Function
Public Function DownIsPressed() As Boolean
DownIsPressed = (GetAsyncKeyState(vbKeyDown) <> 0)
End Function
Public Function LeftIsPressed() As Boolean
LeftIsPressed = (GetAsyncKeyState(vbKeyLeft) <> 0)
End Function
Public Function RightIsPressed() As Boolean
RightIsPressed = (GetAsyncKeyState(vbKeyRight) <> 0)
End Function
Public Function TabIsPressed() As Boolean
TabIsPressed = (GetAsyncKeyState(vbKeyTab) <> 0)
End Function
Class Graphics
Option Explicit
Const COL_WIDTH As Double = 0.83
Const ROW_HEIGHT As Double = 7.5
Private GameCanvas As Range
Private Sub Class_Initialize()
With shtGame
.cmdGo.Visible = False
.Cells.Columns.ColumnWidth = COL_WIDTH
.Cells.Rows.RowHeight = ROW_HEIGHT
.EnableSelection = xlNoSelection
.Protect AllowFormattingCells:=True
.Cells.Interior.Color = rgbDarkSlateGrey
Set GameCanvas = .Range(.Cells(BORDER_START_Y, BORDER_START_X), .Cells(BORDER_END_Y, BORDER_END_X))
GameCanvas.Interior.Pattern = xlNone
End With
End Sub
Public Sub DrawSquare(SquareX As Integer, SquareY As Integer)
Dim SquareRange As Range
With shtGame
Set SquareRange = .Range(.Cells(SquareY, SquareX), .Cells(SquareY + SQUARE_SIZE - 1, SquareX + SQUARE_SIZE - 1))
SquareRange.Interior.Color = SQUARE_COLOUR
End With
End Sub
Private Sub Class_Terminate()
With shtGame
.cmdGo.Visible = True
.EnableSelection = xlNoRestrictions
.Unprotect
.Cells.Clear
End With
End Sub
Class Square
Option Explicit
Private SquareX As Integer
Private SquareY As Integer
Private Sub Class_Initialize()
SquareX = BORDER_START_X
SquareY = BORDER_START_Y
End Sub
Sorry for the big fat code dump, but I really have no idea what is causing the problem!
Any help is greatly appreciated!
The CTD was being caused by missing arguments when calling DrawSquare().
I had incorrectly missed the x and y co-ordinates of the sub.
Normally, the compiler would pick-up on this error, however as the Main module was being called automatically by my timer no error checking was taking place.
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Is there any possible way to track the windows lock and unlock time using vba excel

I want to track the time for windows lock and unlock.
Is there any possible way to track the windows lock and unlock time using vba excel?
Thanks in advance.
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100
Function Check_If_Locked() As String
Dim p_lngHwnd As Long
Dim p_lngRtn As Long
Dim p_lngErr As Long
p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
If p_lngHwnd = 0 Then
system = "Error"
Else
p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
p_lngErr = Err.LastDllError
If p_lngRtn = 0 Then
If p_lngErr = 0 Then
system = "Locked"
Else
system = "Error"
End If
Else
system = "Unlocked"
End If
p_lngHwnd = CloseDesktop(p_lngHwnd)
End If
Check_If_Locked = system
End Function
Private Sub Form_Timer()
Debug.Print Check_If_Locked
End Sub
You are probably better off to look in the event log afterwards rather than trying to use Excel to track in realtime when this happens. See this answer for the event log id values.
There is also this post on SuperUser.

Determine if application is running with Excel

Goal
Have an Excel file with a "Search" button that opens a custom program. This program is used for researches. If the program is already opened when the user clicks on the button, make it popup and focus on that given program.
Current Situation
Here's the code I'm trying to use to make it work:
Search Button
Private Sub btnSearch_Click()
Dim x As Variant
Dim Path As String
If Not IsAppRunning("Word.Application") Then
Path = "C:\Tmp\MyProgram.exe"
x = Shell(Path, vbNormalFocus)
End If
End Sub
IsAppRunning()
Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function
This code will work only when I put "Word.Application" as the executable. If I try to put "MyProgram.Application" the function will never see the program is running. How can I find that "MyProgram.exe" is currently opened?
Further more, I'd need to put the focus on it...
You can check this more directly by getting a list of open processes.
This will search based on the process name, returning true/false as appropriate.
Sub exampleIsProcessRunning()
Debug.Print IsProcessRunning("MyProgram.EXE")
Debug.Print IsProcessRunning("NOT RUNNING.EXE")
End Sub
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
IsProcessRunning = objList.Count > 0
End Function
Here's how I brought the search window to front:
Private Const SW_RESTORE = 9
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Sub btnSearch_Click()
Dim x As Variant
Dim Path As String
If IsProcessRunning("MyProgram.exe") = False Then
Path = "C:\Tmp\MyProgram.exe"
x = Shell(Path, vbNormalFocus)
Else
Dim THandle As Long
THandle = FindWindow(vbEmpty, "Window / Form Text")
Dim iret As Long
iret = BringWindowToTop(THandle)
Call ShowWindow(THandle, SW_RESTORE)
End If
End Sub
Now if the window was minimized and the user clicks the search button again, the window will simply pop up.
Just want to point out that the Window Text may change when documents are open in the application instance.
For example, I was trying to bring CorelDRAW to focus and everything would work fine so long as there wasn't a document open in Corel, if there was, I would need to pass the complete name to FindWindow() including the open document.
So, instead of just:
FindWindow("CorelDRAW 2020 (64-Bit)")
It would have to be:
FindWindow("CorelDRAW 2020 (64-Bit) - C:\CompletePath\FileName.cdr")
As that is what would be returned from GetWindowText()
Obviously this is an issue as you don't know what document a user will have open in the application, so for anyone else who may be coming here, years later, who may be experiencing the same issue, here's what I did.
Option Explicit
Private Module
Private Const EXE_NAME As String = "CorelDRW.exe"
Private Const WINDOW_TEXT As String = "CorelDRAW 2020" ' This is common with all opened documents
Private Const GW_HWNDNEXT = 2
Private Const SW_RESTORE = 9
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Sub FocusIfRunning(parAppName as String, parWindowText as String)
Dim oProcs As Object
Dim lWindowHandle As Long
Dim sWindowText As String
Dim sBuffer As String
' Create WMI object and execute a WQL query statement to find if your application
' is a running process. The query will return an SWbemObjectSet.
Set oProcs = GetObject("winmgmts:").ExecQuery("SELECT * FROM win32_process WHERE " & _
"name = '" & parAppName & "'")
' The Count property of the SWbemObjectSet will be > 0 if there were
' matches to your query.
If oProcs.Count > 0 Then
' Go through all the handles checking if the start of the GetWindowText()
' result matches your WindowText pre-file name.
' GetWindowText() needs a buffer, that's what the Space(255) is.
lWindowHandle = FindWindow(vbEmpty, vbEmpty)
Do While lWindowHandle
sBuffer = Space(255)
sWindowText = Left(sBuffer, GetWindowText(lWindowHandle, sBuffer, 255))
If Mid(sWindowText, 1, Len(parWindowText)) Like parWindowText Then Exit Do
' Get the next handle. Will return 0 when there are no more.
lWindowHandle = GetWindow(lWindowHandle, GW_HWNDNEXT)
Loop
Call ShowWindow(lWindowHandle , SW_RESTORE)
End If
End Sub
Private Sub btnFocusWindow_Click()
Call FocusIfRunning(EXE_NAME, WINDOW_TEXT)
End Sub
Hopefully somebody gets use from this and doesn't have to spend the time on it I did.
Just wanted to say thank you for this solution. Only just started playing around with code and wanted to automate my job a bit. This code will paste current selection in excel sheet into an already open application with as single click. Will make my life so much easier!!
Thanks for sharing
Public Const SW_RESTORE = 9
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Sub updatepart()
'
' updatepart Macro
' copies current selection
' finds and focuses on all ready running Notepad application called Test
' pastes value into Notepad document
' Keyboard Shortcut: Ctrl+u
'
Dim data As Range
Set data = Application.Selection
If data.Count <> 1 Then
MsgBox "Selection is too large"
Exit Sub
End If
Selection.Copy
If IsProcessRunning("Notepad.EXE") = False Then
MsgBox "Notepad is down"
Else
Dim THandle As Long
THandle = FindWindow(vbEmpty, "Test - Notepad")
Dim iret As Long
iret = BringWindowToTop(THandle)
Call ShowWindow(THandle, SW_RESTORE)
End If
waittime (500)
'Call SendKeys("{F7}")
Call SendKeys("^v", True) '{F12}
Call SendKeys("{ENTER}")
End Sub
Function waittime(ByVal milliseconds As Double)
Application.Wait (Now() + milliseconds / 24 / 60 / 60 / 1000)
End Function
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
If objList.Count > 0 Then
IsProcessRunning = True
Else
IsProcessRunning = False
End If
End Function

Resources