Excel VBA: Meldungsfeldfehler in Verbindung

Question

Es gibt eine Website, die Tausende von .csv-Dateien erstellen kann, die Tabellen enthalten. Die CSV-Dateien basieren auf den Informationen, die der Benutzer anfordert.

Ich erstellte eine Excel-Datei mit VBA-Skript. Der Benutzer gibt die Daten in die Excel-Datei ein, dann generiert das VBA-Skript die korrekte URL und versucht, die erforderlichen Daten von der .csv in dieser URL abzurufen.

In meiner Excel-Datei kann der Benutzer nach Hunderten von .csv-Tabellen fragen, und ich möchte, dass der Benutzer die Hunderte von Informationsarten eingeben kann, die er will, dann das VBA-Skript ausführen und den Computer arbeiten lassen es.

Ich zuerst URL-Prüfung, und wenn es in Ordnung ist, versuche ich, die Daten in der CSV-Datei in dieser URL zu erhalten.

die meiste Zeit, es funktioniert völlig in Ordnung. Funktioniert gut für einen Fall, wenn HttpExists TRUE zurückgibt, und funktioniert auch für einen Fall, dass HttpExists FALSE zurückgibt (es überspringt nur die aktuelle aktive Zelle und geht zu dem nächsten).

Aber es gibt ein paar Mal, dass die URL-Prüfung antwortet, dass die URL in Ordnung ist (HttpExists gibt TRUE zurück), aber als es versuchte, die Daten zu erhalten, öffnet es ein Meldungsfeld mit der Aufschrift "Entschuldigung, wir konnten nicht öffne 'URL-Adresse' ". (Meldungsfeld für Laufzeitfehler 1004) und dann werden die VBA-Skripte beendet.

Ich würde gerne wissen, wie ich es beheben kann. Wie kann ich die aktuelle URL im Fehlerfall überspringen, anstatt ein Meldungsfeld anzuzeigen, das den Skriptlauf beendet?

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 

Es geht manchmal mit einem messagebox von Laufzeitfehler aus 1004, und es geschieht in der Leitung von:

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

Ich möchte es nur die aktuelle Zelle in einem Fehlerfall überspringen und mit der nächsten Zelle fortfahren, ohne eine Nachrichtenbox und ohne Absturz.

Wie kann ich es beheben?

Danke

Answer 1

Sehen Sie, wenn Diese Fehlerbehandlungsstruktur funktioniert besser. Ich habe Teile eliminiert, die unnötig sind und angepasst wurden, was funktionieren sollte, aber ich bin nicht sicher, welcher Code in den ..... Sektionen ist. Jedenfalls sollte Ihnen das zumindest ein allgemeines Verständnis vermitteln. Ich habe ein paar Dinge kommentiert, um sie im Code klarer zu erklären.

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 

Answer 2

Sie müssen Ihrem Code eine Fehlerbehandlung hinzufügen. Server-Timeout-Benachrichtigungen spiegeln kein Problem mit Ihrer Codierung wider, sondern ein Problem mit dem Server (zu dem Sie keine Kontrolle haben, es sei denn, Sie haben eine falsche URL eingegeben).

In Ihrem Code, müssen Sie On Error GoTo ErrHandler vergeben, stellen Sie sicher, dass Sie die Fehlernummer haben, und da Sie nur wollen in die nächste Zelle wieder aufnehmen können Sie etwas tun:

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