VBA Excel/ Abandon d'une Requete si echec

Question

Bonjour, 
Il s'agit de mon premier message sur ce forum.
Par contre, j'ai assez souvent recours &#224; l'immense base de donn&#233;es de qualit&#233; que propose le site.

J'ai recopier un code VBA sous Excel qui utilise une Query pour r&#233;cuperer un fichier csv sur un site boursier. Le fichier est trait&#233; et affiche le dernier cours. Il y a pause de 1secondes (contenant un code DoEvents si je souhaite intervenir sur une commande) puis recommence la requete en boucle.
Cela fonctionne plut&#244;t bien, sauf que parfois, la requete n'aboutit pas (peut &#234;tre trop de monde en m&#234;me temps , ou le site est en train de modifier le fichier et celui-ci n'est pas accessible, ou...), et ma macro VBA reste bloqu&#233;e dans sa demande, ind&#233;finiment...
Dans ces rares cas, si j'interompt la macro (escape) puis relance la macro, cela repart me laissant penser que lorsque cela ne marche pas apres quelques secondes, ce n'est pas la peine d'insister et qu'il vaut mieux refaire une demande.

Je ne sais pas traduire cet abandon de tache apres quelques secondes si echec, en VBA, de fa&#231;on &#224; automatiser le processus...

Auriez vous une id&#233;e????

merci d'avance

Tuning Max · Answer

pourrais tu afficher le code pour qu'on y jette un oeil

Utilisateur anonyme · Answer

Il s'agit d'une Macro que j'ai acheté. Pour la comprehension du code, j'ai clairement atteint mon niveau d'incompétence... J'ajoute à mon précédent message que lorsque la requete se fait, en bas à gauche de ma feuille Excel, j'ai le message "connexion web..." à la place de "Prêt" habituellement. Lorsque c'est bloqué, "Connexion web..." reste affiché!!! En fait Escape n'est même pas suffisant, plus d'acces à la fenetre Microsoft Visual Basic par exemple, il faut que je passe en veille du disque dur, puis sortir de la veille et la cela remarche sans aucune autre manipulation, ce qui me fait penser qu'il faut forcer le module a abandonner la requete si echec. Voici le module spécifique de récupération. Il fait appel à d'autres fonctions dans d'autres modules, mais je pense que l'essentiel est là... Option Explicit Private hfactor As Integer Public Sub GetQuotes(InputRange, OutputRange, Optional output_orientation = "R", _Optional format_string "l1", Optional exchange_suffix "", Optional time_zone = "") Dim NumRows As Integer, NumCols As Integer, NumSymbols As Integer Dim RowNum As Integer, ColNum As Integer Dim RowInc As Integer, ColInc As Integer Dim SymbolNum As Integer Dim i As Integer, j As Integer Dim URL As String, suffix As String, URLPrefix As String Dim Orientation Dim ErrorCount As Integer Dim bShowWindowsInTaskbar As Boolean Dim aws As Object 'Dim qt As QueryTable Dim tempWB As Object Dim tempWS As Worksheet Dim c As Object Call Initialize2 hfactor = hFunctions.VBHistoricVolatility(1, 0.94, 0) If hfactor = 0 Then Exit Sub On Error Resume Next If Val(Trim(Application.Version)) > 8 Then 'not possible or necessary in Excel 97 bShowWindowsInTaskbar = Application.ShowWindowsInTaskbar Application.ShowWindowsInTaskbar = False End If Application.ScreenUpdating = False Set aws = ActiveWorkbook.ActiveSheet Orientation = UCase(output_orientation) If Orientation = "C" Then RowInc = 1 ColInc = 0 Else RowInc = 0 ColInc = 1 End If If Len(Trim(exchange_suffix)) <> 0 Then suffix = "." & Trim(exchange_suffix) Else suffix = "" End If URLPrefix = "" If Len(Trim(time_zone)) <> 0 Then URLPrefix = Trim(time_zone) & "." URL = "URL;http://" & URLPrefix & "finance.yahoo.com/d/quotes.csv?s=" 'URL = "URL;http://au.finance.yahoo.com/d/quotes.csv?s=" NumSymbols = 0 'For Each c In aws.Range(InputRange) For Each c In Range(InputRange) If Len(Trim(c.Value)) > 0 And InStr(c.Value, "#") 0 Then URL URL & "+" & Trim(c.Value) & suffix '# causes Yahoo to fail NumSymbols = NumSymbols + 1 Next URL = URL & "&f=" & "l1" & format_string & "&e=.csv" 'column "b" always equals last price Set tempWB = Workbooks.Add 'Set tempWS = tempWB.Worksheets("sheet1") Set tempWS = tempWB.Worksheets(1) 'If tempWS.QueryTables.Count = 0 Then ' Set qt = tempWS.QueryTables.Add("URL;", tempWS.Range("a1")) 'End If 'Set qt = tempWS.QueryTables(1) 'qt.BackgroundQuery = False 'qt.Connection = URL 'qt.Destination = tempWS.Range("a1").Value 'qt.Refresh ErrorCount = 0 TryToGet: err.Number = 0 With tempWS.QueryTables.Add(Connection:=URL, Destination:=tempWS.Range("a1")) .refresh BackgroundQuery:=False End With If err.Number <> 0 And ErrorCount < 6 Then ErrorCount = ErrorCount + 1 err = 0 GoTo TryToGet End If If err.Number <> 0 Then aws.Activate Range(OutputRange).Cells(1, 1).Value = err.Description GoTo CloseTempWorkBook End If tempWS.Range("a:a").TextToColumns Destination:=tempWS.Range("b1"), _ DataType:=xlDelimited, Comma:=True ', DecimalSeparator:="." 'dec. sep not compat w. Exel97 tempWS.Columns("A:A").EntireColumn.AutoFit RowNum = 0 ColNum = 0 SymbolNum = 0 NumCols = tempWS.UsedRange.Cells.Columns.Count aws.Activate For Each c In Range(InputRange) RowNum IIf(Orientation "C", 1, RowNum + 1) ColNum IIf(Orientation "C", ColNum + 1, 1) If Len(Trim(c.Value)) > 0 And InStr(c.Value, "#") = 0 Then SymbolNum = SymbolNum + 1 For j = 3 To NumCols If tempWS.Range("b1").Cells(SymbolNum, 1).Value <> 0 Then Range(OutputRange).Cells(RowNum, ColNum).Value = _ tempWS.Range("a1").Cells(SymbolNum, j).Value End If RowNum = RowNum + RowInc ColNum = ColNum + ColInc Next End If Next CloseTempWorkBook: tempWB.Close savechanges:=False If Val(Trim(Application.Version)) > 8 Then Application.ShowWindowsInTaskbar = bShowWindowsInTaskbar End If Application.ScreenUpdating = True End Sub

Tuning Max · Answer

N&#233;gatif, si j'ai bien tout compris, ce code sert &#224; effectu&#233; un traitement sur les donn&#233;es. Ce qu'il nous serait utile pour pouvoir t'aider, c'est le code qui contient la connexion proprement dit. Je pense qu'il s'agit de la fonction nomm&#233; " Initialize2"
Je pense que le probl&#232;me vient du fait que ta connexion reste ouverte et lorsque tu relance l'op&#233;ration, il entre en conflit avec la premi&#232;re connexion.
Tu peux rajouter ce bout de code dans un module, il permet de retourner le statut d'une connexion.
A mon id&#233;e, tu le colle dans la fonction de connexion afin de l'obliger &#224; fermer la connexion si cette derni&#232;re est d&#233;j&#224; ouverte.
Mais cel&#224; d&#233;pend du mode connexion utilis&#233; !

du genre :

Dim cnx As ADODB.Connection
If GetState(cnx.State) = "adStateOpen" Then
    cnx.Close
End If

Public Function GetState(intState As Integer) As String

   Select Case intState
      Case adStateClosed
         GetState = "adStateClosed"
      Case adStateOpen
         GetState = "adStateOpen"
   End Select

Utilisateur anonyme · Answer

Merci de ton aide, j'ai lancé la macro en pas à pas, et apres plusieurs aller retour dans differents modules, on revient dans celui que j'ai posté ci-dessus... A peu pres au 2/3 de celui-ci, il y a une etiquette appelée TryToGet, avec le code suivant (extrait): ErrorCount = 0 TryToGet: err.Number = 0 With tempWS.QueryTables.Add(Connection:=URL, Destination:=tempWS.Range("a1")) .refresh BackgroundQuery:=False End With If err.Number <> 0 And ErrorCount < 6 Then ErrorCount = ErrorCount + 1 err = 0 GoTo TryToGet End If If err.Number <> 0 Then aws.Activate Range(OutputRange).Cells(1, 1).Value = err.Description GoTo CloseTempWorkBook End If Cette partie semble bien celle qui fait la requete et Importe ensuite le résultat dans un classeur vierge pour traitement. C'est cette requette que je souhaite pouvoir abandonner s'il n'y a pas de réponse apres x secondes... je ne crois pas que le blocage vienne d'une double requete (sous toute reserve de ma petite comprehension du sujet).

Tuning Max · Answer

Peut &#234;tre quand rajoutant un timer cela te permettrais de sortir de la connexion. Je ne sais pas trop mais voil&#224; toujours un petit bout de ton code modifier. Cela pourra peut &#234;tre te donner de nouvelles id&#233;es.
Bon courage

TryToGet:
Err.Number = 0
Dim PauseTime, Start, Finish, TotalTime
Dim intRtn As Integer
    PauseTime = 60    ' D&#233;finit la dur&#233;e en secondes.
    Finish = Timer + PauseTime   ' D&#233;finit l'heure de d&#233;but.
Do While Timer > Finish
        DoEvents    ' Donne le contr&#244;le &#224; d'autres processus.
            If tempWS.QueryTables.Count = 0 Then    ' test de le nombre de tables import&#233;s depuis la connexion
                    intRtn = MsgBox("La connexion semble &#234;tre d&#233;faillante voulez-vous continuer ?", vbYesNo)
                Select Case intRtn
                    Case vbYes
                        GoTo TryToGet
                    Case vbNo
                        Exit Sub
            End If
Loop
    With tempWS.QueryTables.Add(Connection:=URL, Destination:=tempWS.Range("A1"))
        .Refresh BackgroundQuery:=False
    End With
End

VBA Excel/ Abandon d'une Requete si echec

5 réponses

Discussions similaires