Не удается обработать ошибку VBA при запуске последовательных сабвуферов VBA из основного сабвуфера - PullRequest
0 голосов
/ 13 января 2019

У меня есть модуль, который при запуске запускает концептуальные сабвуферы. Есть случай, когда что-то идет не так в сабе. Поэтому я хочу выйти из подпрограммы и перейти к следующей строке в главном подпрограмме, которая похожа на следующую

Sub MasterMacro()
Call EnableTimer

Call getMetaData1
ActiveWorkbook.Save
Application.Wait (Now + TimeValue("0:00:05"))

Call saveTableToCSV

Call getMetaData2
ActiveWorkbook.Save
Application.Wait (Now + TimeValue("0:00:05"))

Call saveTableToCSV

Call getMetaData3
ActiveWorkbook.Save
Application.Wait (Now + TimeValue("0:00:05"))

Call saveTableToCSV

Call getMetaData4
ActiveWorkbook.Save
Application.Wait (Now + TimeValue("0:00:05"))

Call saveTableToCSV

End Sub

Могу ли я поместить общую ошибку в каждую подпункт «Выход из подпункта»? Если я выйду из подпрограммы, она продолжится в следующей строке Main Sub? Большинство ошибок, которые у меня есть,

Ошибка при получении данных с веб-страницы

Ошибка при подключении к веб-странице

Ошибка по таймауту

1 Ответ

0 голосов
/ 14 января 2019

Ниже приведен план сбора данных, который отличается от вашего тем, что он собирает все 4 данные в массив и обрабатывает этот массив только через определенное время (например, 10 секунд, настраивается). Если полные данные доступны ранее, они могут быть записаны ранее, и в этом случае вы можете ограничить очистку определенными интервалами - все вещи, которые намного сложнее сделать, пока вы пытаетесь обрабатывать каждый отдельный элемент отдельно.

Sub RecordData()

    ' create an array with 1 element for each of the 4 data you wish to record
    Dim Arr(1 To 4) As Variant
    Dim TimeOut As Single
    Dim Tmp As String
    Dim Done As Boolean
    Dim i As Integer                            ' loop counter

    TimeOut = Timer + 10                        ' allow 10 seconds to complete scraping
    Do While Not Done
        Done = True
        For i = 1 To 4
            If IsEmpty(Arr(i)) Then
                Tmp = GetMetaData(i)            ' get the scraped string
                Done = Len(Tmp)                 ' sets Done to False if Tmp is ""
            End If
        Next i
        If Timer > TimeOut Then Exit Do         ' end the loop on time-out
    Loop

    ' Now write the contents of Arr to your workbook
    ' It may be complete or not.
End Sub

Private Function GetMetaData(DataID As Integer) As String

    ' DataID should mark the difference between your
    ' procedures GetMwetaDat1 thru 4.
    ' If you don't know how to merge the 4 procedures into one
    ' on that basis, the following setup could be used.
    GetMetaData = Application.Run("GetMetaData" & DataID)

    ' The GetMetaData# procedures must be created as functions
    ' which return nothing if an error occurred.
    ' capture the error with
    On Error Resume Next
    If Err.Number = 0 Then
        ' GetMetaData# = [Scraped value]
    End If
    Err.Clear
    ' The above setup will return an empty string ("")
    ' if an error occurred in the scraping
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...