Используйте обработчик ошибок, чтобы пользователи могли попробовать отправить форму еще раз, если она не сработала в первый раз. - PullRequest
Новая
       9

Используйте обработчик ошибок, чтобы пользователи могли попробовать отправить форму еще раз, если она не сработала в первый раз.

0 голосов
/ 19 июня 2020

Итак, я создаю пользовательскую форму, которую заполняют несколько человек. Общий файл базы данных будет храниться в 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, которую пользователи могут нажать, чтобы через несколько секунд попытаться отправить форму еще раз? А также это должно предотвратить закрытие пользовательской формы, так как я не хочу, чтобы они снова заполняли все это, если происходит ошибка.

Пожалуйста, помогите, спасибо

1 Ответ

0 голосов
/ 19 июня 2020

Вы можете попробовать вызвать msgbox с аргументом vbAbortRetryCancel или vbOKCancel, введите здесь описание ссылки и измените структуру подпрограммы следующим образом: 

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