time-out:

[ArjanVries]

time-out inbouwen bij opslaan:

Ik heb een formulier gemaakt waarmee meerdere gebruikers gegevens kunnen opslaan in een 2e excelbestandje (soort database).
Op het moment dat 2 gebruikers tegelijk op opslaan drukken krijgt 1 de melding "bestand opslaan als kopie...."

Kostentechnisch kan dit niet met access worden opgelost dus ik vraag me of er een mogelijkheid bestaat om een soort time-out in te bouwen (of een stop) zodat nogmaals op de knop moet worden gedrukt.

code onder de knop Opslaan :

Dim MutatieNr As Integer
Dim bestand As String
Dim locatie As String
Dim deelnemers As Integer
Dim odatum As Date 'verplicht invoerveld

bestand = Worksheets("info").Range("B4")
locatie = Worksheets("info").Range("B5")

If lstcontractnr = "" Then
MsgBox "Svp een contract kiezen", vbExclamation, "Contract"
lstcontractnr.SetFocus
Exit Sub
End If

If lstmutatie.Text = "Aanmelding deelnemer" And txtVz.Text = "" Then
MsgBox "Bij nieuwe deelnemer naam verplicht", vbCritical, "Naam deelnemer"
txtVz.SetFocus
Exit Sub
End If

If txtpolisnummer = "" And txtdeelnemers = "" And lstmutatie.Text = "Aanmelding deelnemer" Then
txtdeelnemers = 1
End If

If txtpolisnummer = "" And txtdeelnemers = "" Then
MsgBox "Svp een polisnummer kiezen of het aantal deelnemers opgeven", vbExclamation, "Polisnummer"
txtpolisnummer.SetFocus
Exit Sub
End If

If txtpolisnummer <> "" And txtdeelnemers <> "" Then
MsgBox "Svp geen polisnummer invullen bij een opgegeven aantal deelnemers", vbExclamation, "Polisnummer"
txtpolisnummer.SetFocus
Exit Sub
End If

If txtpolisnummer = "" And txtdeelnemers <> "" And lstmutatie.Text <> "Aanmelding deelnemer" Then
txtpolisnummer = "contract mutatie"
End If

If lstmutatie = "" Then
MsgBox "Svp een mutatiecode kiezen", vbExclamation, "Mutatiecode"
lstmutatie.SetFocus
Exit Sub
End If

If txtontvangst <> "" And IsDate(txtontvangst) = False Then
MsgBox "Geen geldige ontvangsdatum ingevuld", vbExclamation, "Ontvangstdatum"
txtontvangst.SetFocus
Exit Sub
End If

If txtpolisnummer = "" And lstmutatie.Text = "Aanmelding deelnemer" Then
txtdeelnemers = 1
End If
If txtpolisnummer <> "" And txtpolisnummer <> "contract mutatie" Then
txtdeelnemers = 1
End If
If IsDate(txtontvangst) = False Then
txtontvangst = txtregistratie
End If

odatum = txtontvangst

Workbooks.Open locatie & bestand, ReadOnly:=False
Worksheets("Openstaand").Activate
MutatieNr = fctMutNr
Worksheets("Openstaand").Range("A5").Select
If Worksheets("Openstaand").Range("A5").Value = "" Then
Worksheets("Openstaand").Range("A5").Activate
Else
Worksheets("Openstaand").Range("A5").CurrentRegion.Select
ActiveCell.Offset(Selection.Rows.Count, 0).Activate
End If

With ActiveCell
.Value = MutatieNr
.Offset(0, 1).Value = fctContractNr
.Offset(0, 2).Value = fctContract
.Offset(0, 3).Value = txtpolisnummer.Text
.Offset(0, 4).Value = txtdeelnemers.Value
.Offset(0, 5).Value = txtVz.Value
.Offset(0, 6).Value = txtmutatiecode.Value
.Offset(0, 7).Value = lstmutatie.Value
.Offset(0, 8).Value = odatum
'rappeldatum invoegen bij wijzigen status
.Offset(0, 10).Value = txtstatus.Text
.Offset(0, 11).Value = fctRegDat
.Offset(0, 12).Value = Application.UserName
.Offset(0, 13).Value = txtopmerking.Text
End With
Windows(bestand).Close , savechanges:=True

MsgBox "Mutatie is opgeslagen", vbInformation, "Opslaan mutatie"

Unload frmNieuw

Ik heb om de workbooks.open een for.next lus gemaakt die een x aantal keer probeert of het geopende bestand lezenschrijven is op de volgende manier:
for i = 1 to 25
if workbooks(strbestand).readonly = true then
workbooks(strbestand).close 'readonly bestand wordt toch nooit opgeslagen
else
exit for 'niet meer dan nodig loopen
end if
if i >= 25 then exit sub

Als iemand ooit een beter oplossing weet, gaarne.