excel - 使用错误处理程序，如果用户第一次无法使用该表单，则可以让用户尝试再次提交该表单

Question

因此，我正在构建一个将由多个人填写的用户表单。通用数据库文件将保存在Sharepoint。该表格只有在2个人同时按下提交按钮之前才能正常运行。

为了解决此问题，我想到了一个错误处理程序，该错误处理程序将在第二个用户尝试同时提交表单时显示，并且消息会提示其他人正在使用该表单，请稍后重试。

这是我当前的提交代码:

Sub Submit()
    On Error GoTo eh
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.AutomationSecurity = msoAutomationSecurityLow
    If frmForm.txtAE.Value = "" Or frmForm.txtAPL.Value = "" Or frmForm.txtBatches.Value = "" Or frmForm.txtProject.Value = "" Or frmForm.txtQA.Value = "" Or frmForm.txtTeam.Value = "" Or frmForm.cmbDS.Value = "" Or frmForm.cmbPriority.Value = "" Or frmForm.cmbRelease.Value = "" Then
        MsgBox ("Complete All fields marked with (*) to proceed")
    Else
        Dim strFileName As String
        Dim strFileExists As String
        'Call Downloadtest
        strFileName = ""
        strFileExists = Dir(strFileName)

        If strFileName <> "" Then
            MsgBox ("Another user is currently submitting a booking. Please wait for a minute, and then try again.")
        Else

            Dim nwb As Workbook
            Set nwb = Workbooks.Open("sharepoint link")

            nwb.Sheets("Sheet1").Unprotect Password:="password"
            Dim emptyRow As Long
            emptyRow = WorksheetFunction.CountA(nwb.Sheets("Sheet1").Range("A:A")) + 1

            Dim arDate As Variant
            arDate = Split(frmForm.dtPlanned.Value, "/")
            With nwb.Sheets("Sheet1")

                .Cells(emptyRow, 1) = emptyRow - 1
                .Cells(emptyRow, 2) = Date
                .Cells(emptyRow, 3) = frmForm.txtProject.Value
                .Cells(emptyRow, 4) = frmForm.txtTeam.Value
                .Cells(emptyRow, 5) = frmForm.txtAPL.Value
                .Cells(emptyRow, 6) = frmForm.txtQA.Value
                .Cells(emptyRow, 7) = frmForm.txtAE.Value
                .Cells(emptyRow, 8) = frmForm.cmbRelease.Value
                .Cells(emptyRow, 9) = frmForm.cmbDS.Value
                .Cells(emptyRow, 10) = frmForm.txtBatches.Value
                .Cells(emptyRow, 11) = frmForm.dtReview.Value
                .Cells(emptyRow, 12) = frmForm.dtSubmission.Value
                .Cells(emptyRow, 13) = frmForm.dtRelease.Value
                If frmForm.dtPlanned.Value = "" Then .Cells(emptyRow, 14) = "" Else .Cells(emptyRow, 14) = DateSerial(arDate(2), arDate(1), arDate(0))
                .Cells(emptyRow, 15) = frmForm.cmbPriority.Value
                .Cells(emptyRow, 16) = "Pending"
                .Cells(emptyRow, 17) = frmForm.txtRemarks.Value
                .Cells(emptyRow, 18) = Application.UserName

            End With
            nwb.Sheets("Sheet1").Protect Password:="password"
            'nwb.SaveAs ("sharepoint link")


            nwb.SaveAs Filename:="sharepoint link"
            nwb.Close
            'Kill ("C:\Users\username\Downloads\Planning Sheet\KF 6.0_checkout.xlsm")
            MsgBox ("Your Entry has been recorded.")
        End If
    End If
    Unload frmForm
eh:
    MsgBox("Someone else using the file")
End Sub

请忽略strFilename，strFileexists，我必须清理该部分。

问题是单击错误的“确定”后，窗体关闭。
我们可以在错误MsgBox上添加“重试”按钮的任何方式，用户可以按该按钮，以便他们可以在几秒钟后尝试再次提交表单？而且它还应防止关闭用户窗体，因为如果发生错误，我不希望他们再次填写整个内容。

请帮忙，谢谢

Answer 1

您可以尝试使用vbAbortRetryCancel或vbOKCancel参数enter link description here调用msgbox，并以如下方式重构子:

Sub Submit()
     On Error ...
     iStat = vbRetry
     Do While iStat = vbRetry
        ...
         Unload frmForm
         iStat = vbOK 
     eh:
         iStat = MsgBox ("Someone...
     Loop