VBA Excel/ Abandon d'une Requete si echec

Utilisateur anonyme - 26 sept. 2005 à 15:21
Tuning Max
Messages postés
314
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
31 août 2006
- 27 sept. 2005 à 12:35
Bonjour,
Il s'agit de mon premier message sur ce forum.
Par contre, j'ai assez souvent recours à l'immense base de données de qualité que propose le site.

J'ai recopier un code VBA sous Excel qui utilise une Query pour récuperer un fichier csv sur un site boursier. Le fichier est traité 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ôt bien, sauf que parfois, la requete n'aboutit pas (peut être trop de monde en mê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ée dans sa demande, indé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çon à automatiser le processus...

Auriez vous une idée????

merci d'avance

5 réponses

Tuning Max
Messages postés
314
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
31 août 2006
1
26 sept. 2005 à 15:46
pourrais tu afficher le code pour qu'on y jette un oeil
0
Utilisateur anonyme
26 sept. 2005 à 16:09
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
0
Tuning Max
Messages postés
314
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
31 août 2006
1
26 sept. 2005 à 18:05
Négatif, si j'ai bien tout compris, ce code sert à effectué un traitement sur les donné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é " Initialize2"
Je pense que le problème vient du fait que ta connexion reste ouverte et lorsque tu relance l'opération, il entre en conflit avec la première connexion.
Tu peux rajouter ce bout de code dans un module, il permet de retourner le statut d'une connexion.
A mon idée, tu le colle dans la fonction de connexion afin de l'obliger à fermer la connexion si cette dernière est déjà ouverte.
Mais celà dépend du mode connexion utilisé !

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
0
Utilisateur anonyme
26 sept. 2005 à 22:46
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).
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Tuning Max
Messages postés
314
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
31 août 2006
1
27 sept. 2005 à 12:35
Peut être quand rajoutant un timer cela te permettrais de sortir de la connexion. Je ne sais pas trop mais voilà toujours un petit bout de ton code modifier. Cela pourra peut être te donner de nouvelles idées.
Bon courage

TryToGet:
Err.Number = 0
Dim PauseTime, Start, Finish, TotalTime
Dim intRtn As Integer
PauseTime = 60 ' Définit la durée en secondes.
Finish = Timer + PauseTime ' Définit l'heure de début.
Do While Timer > Finish
DoEvents ' Donne le contrôle à d'autres processus.
If tempWS.QueryTables.Count = 0 Then ' test de le nombre de tables importés depuis la connexion
intRtn = MsgBox("La connexion semble être dé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
0