Excel VBA：接続中のメッセージボックスエラー

Question

テーブルを含む数千の.csvファイルを作成するWebサイトがあります。 CSVファイルは、ユーザーが尋ねる情報に基づいています。

VBAスクリプトを使用してExcelファイルを作成しました。ユーザーがExcelファイルにデータを入力すると、VBAスクリプトは正しいURLを生成し、そのURLの.csvから必要なデータを取得しようとします。

私のExcelファイルでは、ユーザーは何百もの.csvテーブルを要求することができます。ユーザーは何百もの種類の情報を入力してから、VBAスクリプトを実行して、それ。

まずURLチェックを行い、問題がなければそのURLの.csvファイルにデータを取得しようとします。

ほとんどの場合、完全に正常に動作します。 HttpExistsがTRUEを返す場合にうまく動作し、HttpExistsがFALSEを返す場合も正常に動作します（現在のアクティブセルをスキップして次のセルに移動します）。

しかし、URLチェックではURLが正常であると答えていますが（HttpExistsはTRUEを返します）、データを取得しようとすると「申し訳ありませんが、 「URLアドレス」を開いてください。 （ランタイムエラー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

かどうかを確認しますこのエラー処理構造がうまく機能します。私は不必要な部分を取り除き、何がうまくいくのか調整しましたが、どのコードが.....セクションにあるのか分かりません。とにかく、これは少なくともあなたに一般的な理解を与えるはずです。私はコードでより明確に説明するためにいくつかの点をコメントしました。

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

コードにエラー処理を追加する必要があります。サーバーのタイムアウト通知には、コーディングの問題は反映されませんが、サーバーに問題があります（間違ったURLを入力した場合を除き、制御できません）。あなたのコードで

、あなたはエラー番号を持っていることを確認し、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