on error doesn't work

**ilkamalo** · 05-20-2009, 09:08 PM

when i disable internet connection to try the error procedure instead of doing the line related to the error the macro show a message error ; can someone tell where the error is thanks .i've added 2 attachments too to see what happens when i push F8.


Workbooks.Add.Activate
ActiveWorkbook.SaveAs Filename:="C:\documenti1\documenti2\FONDI1\downloaded_etf"
Sheets("Foglio1").Activate
Sheets("Foglio1").Name = "dati etf"
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.borsaitaliana.it/bitApp/listino?service=Data&lang=it&main_list=11&sub_list=2" _
        , Destination:=ActiveCell)
        .Name = "listino?service=Data&lang=it&main_list=11&sub_list=2"
        .FieldNames = True
        .RowNumbers = False
       .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6,7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        
Etichetta1:
        
        .Refresh BackgroundQuery:=False
        
        'On Error Resume Next
        On Error GoTo Etichetta

       
       
       
    End With

**shg** · 05-20-2009, 09:17 PM

Error handling should be structured like this:

Sub Test()
    ' code that should not error
    
    On Error GoTo Oops
    '
    ' code that may raise an error
    '
    On Error GoTo 0
    
    ' code that should not error

Outtahere:
    Exit Sub ' to avoid error handler
    
Oops:
    ' code to handle error
    
    Resume Next     ' to resume where you left off
    Resume Outtahere  ' or this, to go to the normal exit
End Sub

**ilkamalo** · 05-21-2009, 03:41 AM

thank for your help ; but there is still some problem when there is no connection it enter Etichetta1:
and give me the same error ; with connection evrything is ok

Sub IN_LAVORAZIONE()
       Dim cont As Byte


       
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.borsaitaliana.it/bitApp/listino?service=Data&lang=it&main_list=11&sub_list=2" _
        , Destination:=ActiveCell)
        .Name = "listino?service=Data&lang=it&main_list=11&sub_list=2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6,7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
Etichetta1:
        On Error GoTo Etichetta
        .Refresh BackgroundQuery:=False
        On Error GoTo 0
        End With
       
 
        
        Exit Sub
Etichetta:
       CreateObject("WScript.Shell").Popup "nuovo tentativo: " & cont & " di 60    tra 5 secondi", 1, "errore nello scaricare i dati"
       Sleep 5000
       cont = cont + 1
       If cont = 60 Then
       MsgBox "PROBLEMA SULLA RETE INTERNET impossibile scaricare i dati"
       End If
    
       GoTo Etichetta1
        
        
        
     
   End Sub

**royUK** · 05-21-2009, 04:05 AM

You still have the On Error in the wron place, it should be before the code starts

Option Explicit

Sub IN_LAVORAZIONE()
    Dim cont   As Byte

    On Error GoTo Etichetta

    With ActiveSheet.QueryTables.Add(Connection:= _
                                     "URL;http://www.borsaitaliana.it/bitApp/listino?service=Data&lang=it&main_list=11&sub_list=2" _
                                     , Destination:=ActiveCell)
        .Name = "listino?service=Data&lang=it&main_list=11&sub_list=2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6,7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
Etichetta1:
        .Refresh BackgroundQuery:=False
    End With

    On Error GoTo 0

    Exit Sub
Etichetta:
    CreateObject("WScript.Shell").Popup "nuovo tentativo: " & cont & " di 60    tra 5 secondi", 1, "errore nello scaricare i dati"
    Sleep 5000
    cont = cont + 1
    If cont = 60 Then
        MsgBox "PROBLEMA SULLA RETE INTERNET impossibile scaricare i dati"
    End If

    GoTo Etichetta1


End Sub