Suppress displayalerts when calling procedure in another workbook

[StefanVanSusteren]

Hi all,

I am calling a procedure in another workbook with VBA. The workbook is already open. I am trying to suppress all alerts with application.displayalerts = False.
I added the application.displayalerts in both procedures.

But after calling the procedure in the other workbook I am still getting alerts.
To call the procedure I use:

Application.Run "'" & wkb.Name & "'!" & Module & "." & Procedure

Is there a way to suppress the alerts, or a workaround?

Thanks for your help.

 

[Jaafar Tribak]

The issue is located on my network drive. When I am running the whole thing from my own C-drive, it works perfectly.

So code is working, network drive is doing something strange.

Only solution to automate would be to have a workaround to automatically select "Read only" on the "File in use" alert.

When the alert pops up, what happens next ? Do you just go ahead and cancel the prompt alert and everything else works fine from then on?

If so, you could dismiss the alert prompt via vba code.. Obviously, with some method other than Application.DisplayAlerts=False.

 

[Jaafar Tribak]

Do you get this Prompt :



or this one ?

 

[Jaafar Tribak]

Ok- let's give this a try for supressing the "File In Use" Alert Prompt.

Word of caution:
Please, before testing this, save all the workbooks that you may have open in the current excel session including the active workbook of course... This is because the code uses a windows CBT hook which can crash the application if an unexpected error occurs !

If no error occurs the first time you test the code then it should be fine in subsequent runs as the code automatically removes the windows hook and cleans up itself.


1- Place this code in a Standard Module :

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private lHook As LongPtr
#Else
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private lHook As Long
#End If

Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const WM_CLOSE As Long = &H10


Public Property Let DisplayAlerts_API(ByVal Enable As Boolean)
    If Enable = False Then
        lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
    Else
        UnhookWindowsHookEx lHook
    End If
End Property

#If VBA7 Then
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Dim sBuffer As String * 256
    Dim lRet As Long

    If idHook = HCBT_ACTIVATE Then
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "bosa_sdm_XL9" Then
            lRet = GetWindowText(wParam, sBuffer, 256)
            If UCase(Left(sBuffer, lRet)) = UCase("File In Use") Then
                UnhookWindowsHookEx lHook
                SendMessage wParam, WM_CLOSE, 0, 0
            End If
        End If
    End If
    HookProc = CallNextHookEx(lHook, idHook, ByVal wParam, ByVal lParam)
End Function

2- Code Usage test:

Option Explicit

Sub Test()
    DisplayAlerts_API = False
[COLOR=#006400][B]        'run your code HERE...[/B][/COLOR]
        Application.Run "'" & wkb.Name & "'!" & Module & "." & Procedure
    DisplayAlerts_API = True
End Sub

 

[StefanVanSusteren]

When the alert pops up, what happens next ? Do you just go ahead and cancel the prompt alert and everything else works fine from then on?

If so, you could dismiss the alert prompt via vba code.. Obviously, with some method other than Application.DisplayAlerts=False.

Yes that is what happens.

 

[StefanVanSusteren]

Do you get this Prompt :



or this one ?

The first one

 

[StefanVanSusteren]

Ok- let's give this a try for supressing the "File In Use" Alert Prompt.

Word of caution:
Please, before testing this, save all the workbooks that you may have open in the current excel session including the active workbook of course... This is because the code uses a windows CBT hook which can crash the application if an unexpected error occurs !

If no error occurs the first time you test the code then it should be fine in subsequent runs as the code automatically removes the windows hook and cleans up itself.


1- Place this code in a Standard Module :

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private lHook As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private lHook As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const WM_CLOSE As Long = &H10


Public Property Let DisplayAlerts_API(ByVal Enable As Boolean)
    If Enable = False Then
        lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
    Else
        UnhookWindowsHookEx lHook
    End If
End Property

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim sBuffer As String * 256
    Dim lRet As Long

    If idHook = HCBT_ACTIVATE Then
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "bosa_sdm_XL9" Then
            lRet = GetWindowText(wParam, sBuffer, 256)
            If UCase(Left(sBuffer, lRet)) = UCase("File In Use") Then
                UnhookWindowsHookEx lHook
                SendMessage wParam, WM_CLOSE, 0, 0
            End If
        End If
    End If
    HookProc = CallNextHookEx(lHook, idHook, ByVal wParam, ByVal lParam)
End Function

2- Code Usage test:

Option Explicit

Sub Test()
    DisplayAlerts_API = False
[COLOR=#006400][B]        'run your code HERE...[/B][/COLOR]
        Application.Run "'" & wkb.Name & "'!" & Module & "." & Procedure
    DisplayAlerts_API = True
End Sub

I will give this a try somewhere this week. Thanks for your help