Question

有一个网站，可以创建数千个包含表格的.csv文件。 CSV文件基于用户要求的信息。

我使用VBA脚本创建了一个excel文件。用户将数据输入excel文件，然后VBA脚本生成正确的URL，并尝试从该URL中的.csv获取所需数据。

在我的excel文件中，用户可以要求数百个.csv表，我希望用户能够输入他想要的数百种信息，然后运行VBA脚本并让计算机处理它

我首先进行URL检查，如果没问题，我会尝试在该URL中的.csv文件中获取数据。

大多数时候，它完全正常。适用于HttpExists返回TRUE的情况，并且对于HttpExists返回FALSE的情况也适用（它只是跳过当前活动单元格并转到下一个）。

但有几次，URL检查回答URL没问题（HttpExists返回TRUE），但是当它试图获取数据时，会打开一个消息框，显示“抱歉，我们无法打开'url address'“。（运行时错误1004的消息框），然后VBA脚本终止。

我想知道如何解决它。如何在出现错误时跳过当前URL，而不是显示终止脚本运行的消息框？

Sub my_method()

On Error GoTo handleCancel

Dim errorFlag As Boolean



 .......

Do Until ActiveCell.Value = ""
    errorFlag = True

    URLstring= ....

    ........

        If Not HttpExists(URLstring) Then
            symbolStatus = "Data unavailable"
            logAddress = updateLog("invalid URL " & ActiveCell.Value, logAddress, debugString)
            Application.DisplayAlerts = False
            Sheets(currentSymbol).Delete
            Application.DisplayAlerts = True
        Else
            With Sheets(currentSymbol).QueryTables.Add(Connection:= _
                "TEXT;" & URLstring _
                , Destination:=Sheets(currentSymbol).Range(dataAddress))
                .Name = ""
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlOverwriteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 850
                .TextFileStartRow = 2
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 9)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With

  .......

    errorFlag = False
 handleCancel:
    ActiveCell.Offset(1, 0).Select

    If errorFlag = True Then
            symbolStatus = "Data unavailable"
            logAddress = updateLog("invalid URL " & ActiveCell.Value,      
                         logAddress, debugString)
            Application.DisplayAlerts = False
            Sheets(currentSymbol).Delete
            Application.DisplayAlerts = True
    End If

Loop
 End Sub




Function HttpExists(sURL As String) As Boolean
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.ServerXMLHTTP")

    If Not UCase(sURL) Like "HTTP:*" Then
        sURL = "http://" & sURL
    End If

    On Error GoTo haveError
    oXHTTP.Open "HEAD", sURL, False
    oXHTTP.send
    HttpExists = IIf(oXHTTP.status = 200, True, False)
    Exit Function

haveError:
    HttpExists = False
End Function

它有时会出现运行时错误1004的消息框，它发生在以下行：

        With Sheets(currentSymbol).QueryTables.Add(Connection:= _
            "TEXT;" & URL _

我希望它只是在出现错误的情况下跳过当前单元格，继续下一个单元格，没有任何消息框而且没有崩溃。

我该如何解决？

由于

Answer 1

您需要为代码添加错误处理。服务器超时通知并不反映您的编码问题，但是服务器存在问题（这是您无法控制的，除非您输入了错误的网址）。

在您的代码中，您需要放置On Error GoTo ErrHandler，确保您有错误编号，并且由于您只想恢复到下一个单元格，您可以执行以下操作：

Sub Test()
    On Error GoTo ErrHandler

    'Your code

    Exit Sub
ErrHandler:
    If Err.Number = 123456 Then
        'Get the code ready for the next cell, if necessary
        Resume Next
    Else
        'Other Errs
    End If
End Sub

Answer 2

查看此错误处理结构是否更好。我删除了不必要的部分并根据应该工作的部分进行了调整，但我不确定.....部分中的代码是什么。无论如何，这至少应该给你一个大致的了解。我评论了一些事情，以便在代码中更清楚地解释。

Option Explicit

Sub my_method()

    Do Until ActiveCell.Value = ""

        'URLstring= ....

        If Not HttpExists(URLstring) Then

            LogError 'create sub since you do same thing twice

        Else

            On Error GoTo handleBadURL 'now is only time you need to move to actual error handling

            With Sheets(currentSymbol).QueryTables.Add(Connection:= _
                "TEXT;" & URLstring _
                , Destination:=Sheets(currentSymbol).Range(dataAddress))
                .Name = ""
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlOverwriteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 850
                .TextFileStartRow = 2
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 9)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With

            On Error Go To 0 'reset error handling (doesn't matter so much here, but good practice to always reset when not needed

        End If

        ActiveCell.Offset(1, 0).Select

    Loop

Exit Sub 'leave sub when all is done (so it doesn't move to error handling code below

handleBadURL:

        LogError 'created sub since you do same thing twice
        Resume Next 'this statement will allow code to continue from point of error onward (the loop will keep going

 End Sub


Sub LogError()

    symbolStatus = "Data unavailable"
    logAddress = updateLog("invalid URL " & ActiveCell.Value, logAddress, debugString)
    Application.DisplayAlerts = False
    Sheets(currentSymbol).Delete
    Application.DisplayAlerts = True

End Sub

Excel VBA：连接中的消息框错误

2 个答案: