VBA - Password prompts again when file is read only

i have an issue where the combination of password protection and read only interferes. I have a "data collector" where a lot of people fill in another form and transfer the data via a button. I wanna check if this file everyone writes in is read only (preventing data from not getting lost) and if so you get a message that a transfer is currently in progress and if he/she want's to wait a bit or cancel the process... I realised that as long as the Data Collector is password protected, the macro stops as soon as the file IS read only even though i provided the password.

Sub Readonlytest()
Dim OpenAgain As Integer
DoAgain:
Application.DisplayAlerts = False
Workbooks.Open Filename:= _
"Path\ReadOnly Test.xlsx", Password:="PW"
If Workbooks("ReadOnly Test.xlsx").ReadOnly Then
    Workbooks("ReadOnly Test.xlsx").Close (False)
    Application.DisplayAlerts = True
    OpenAgain = MsgBox("Data Transfer in progress. Try again?", vbYesNo)
    
    If OpenAgain = vbYes Then
        Application.Wait (Now + TimeValue("00:00:04"))
        GoTo DoAgain
    End If
    If OpenAgain = vbNo Then
        MsgBox "Try again later."
        Exit Sub
    End If
End If

Any ideas?

Setting Display Alerts to false didn't work
when not opened by anyone everything works fine
if workbook isn't password protected this code works as well

Solution

Check if this works:

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
       (ByVal ClassName As String, ByVal WindowName As String) As LongPtr

Private Declare PtrSafe Function SetForegroundWindow Lib "user32" _
       (ByVal hwnd As LongPtr) As LongPtr
       
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr

Private Sub Sleep(Milisegundos As Long, Optional ByVal HabilitaEventos As Boolean = True)
    Dim agora As LongPtr, Fim As LongPtr
    agora = GetTickCount
    Fim = agora + Milisegundos
    Do While GetTickCount < Fim
        DoEvents
    Loop
End Sub

Sub Readonlytest()

    'Change theses constants to your country!!
    Const cFileInUse = "Arquivo em uso"
    Const cPassword = "Senha"
    
    Dim OpenAgain As Integer
DoAgain:
    'Application.DisplayAlerts = False
    
   ' Find the number of instances of excel
    Dim objInstanceExcel As Object
    Dim qtExcel As Long
    Set objInstanceExcel = GetObject("winmgmts:").ExecQuery("select * from win32_process where name='excel.exe'")
    qtExcel = objInstanceExcel.Count

    'Open a new instance of excel to open the file
    Shell """C:\Program Files\Microsoft Office\Office16\EXCEL.EXE"" /E ""D:\ReadOnly Test.xlsx""", vbMaximizedFocus
    Dim hwnd As LongPtr
    'Wait the load of the new instance
    Do While objInstanceExcel.Count = qtExcel
        Sleep 200 '
        Set objInstanceExcel = GetObject("winmgmts:").ExecQuery("select * from win32_process where name='excel.exe'")
    Loop
    
    Dim i As Long
    hwnd = FindWindow("bosa_sdm_XL9", cFileInUse)
    
    Do While hwnd = 0 And i < 5 'Change the number of tries if necessary
        Sleep 1000
        hwnd = FindWindow("bosa_sdm_XL9", cFileInUse)
        i = i + 1
    Loop
    'Find the "File in use" dialog
    hwnd = FindWindow("bosa_sdm_XL9", cFileInUse)
    If hwnd <> 0 Then 'The file is in use. We need to close it
        'Force the focus on the window
        'MouseClickHwnd hwnd
        SetForegroundWindow hwnd
        'Cancel msgbox and close the instance
        SendKeys "{ESCAPE}%{F4}"
        
        'Application.DisplayAlerts = True
        OpenAgain = MsgBox("Data Transfer in progress. Try again?", vbYesNo)

        If OpenAgain = vbYes Then
            Sleep 4000
            'Application.Wait (Now + TimeValue("00:00:04"))
            GoTo DoAgain
        Else 'End If
             'If OpenAgain = vbNo Then
            MsgBox "Try again later."
            Exit Sub
        End If
    Else 'Ok Open file with password in other process
        'Find the "Password" dialog
        hwnd = FindWindow("bosa_sdm_XL9", cPassword)
        Do While hwnd = 0
            Sleep 100
            hwnd = FindWindow("bosa_sdm_XL9", cPassword)
        Loop
        'Force the focus on the window
        SetForegroundWindow hwnd
        'Send the password
        SendKeys "PW{ENTER}"
    End If
End Sub