Melding bestand is nu beschikbaar uit zetten.

[Niels28]

Hallo,

Ik heb een macro gemaakt om met meerdere personen info weg te schrijven naar een bestand, als er nu toevallig 2 personen dit op hetzelfde moment zouden doen dan gaat het mis.
Dit heb ik opgelost door application.wait er bij te zetten. Dit werkt maar dan krijg ik volgende melding:

Bestand is nu beschikbaar.



Deze melding wil ik niet.
Ik heb displayalerts al uitgezet maar dat helpt niet.

Sub Mailen()
On Error Resume Next
Application.ScreenUpdating = False

ditblad = ActiveSheet.Name
Workbooks.Open Filename:="F:\DATA\Bedrijfsbureau\Inkoop\totaalinkoop.xlsx"
If ActiveWorkbook.ReadOnly = True Then
    Application.DisplayAlerts = False
    Workbooks("Totaalinkoop.xlsx").Close savechanges:=False
    Application.Wait (Now + TimeValue("0:00:03"))
    Workbooks.Open Filename:="F:\DATA\Bedrijfsbureau\Inkoop\totaalinkoop.xlsx"
    If ActiveWorkbook.ReadOnly = True Then
        Workbooks("Totaalinkoop.xlsx").Close savechanges:=False
        ThisWorkbook.Activate
        MsgBox ("Totaal overzicht is in gebruik, probeer het nogmaals.")
        Exit Sub
    End If
End If
With Workbooks("Totaalinkoop.xlsx").Sheets("totaal")
    x = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(x, 1).Value = ThisWorkbook.Sheets(ditblad).Range("H6").Value
    .Cells(x, 2).Value = ThisWorkbook.Sheets(ditblad).Range("j6").Value
    .Cells(x, 3).Value = ThisWorkbook.Sheets(ditblad).Range("c12").Value
    .Cells(x, 4).Value = ThisWorkbook.Sheets(ditblad).Range("j41").Value
    .Cells(x, 5).Value = ThisWorkbook.Sheets(ditblad).Range("c13").Value
    .Cells(x, 6).Value = ThisWorkbook.Sheets(ditblad).Range("c14").Value
    .Cells(x, 7).Value = ThisWorkbook.Sheets(ditblad).Range("c18").Value
    .Cells(x, 8).Value = ThisWorkbook.Sheets(ditblad).Range("c11").Value
End With
Workbooks("Totaalinkoop.xlsx").Close savechanges:=True
ThisWorkbook.Activate
On Error GoTo 0
End Sub

Niels