Problème de lecture de données web

Résolu/Fermé
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - 22 juil. 2016 à 15:03
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - 22 juil. 2016 à 16:04
Bonjour,

Je sais ça paraît complètement incroyable, mais voilà, dans mon module ThisWorkbook, j'ai le code suivant :

Private Sub Workbook_Open()

Dim j As Integer, i As Integer

On Error Resume Next

For i = 1 To 3

    Sheets(i).Visible = True

Next i

On Error GoTo 0

PARAMETRAGE_OUI = False

With UserForm_Parametrage

    .Show 0

   For i = 10 To 0 Step -1
   
        DoEvents
        If PARAMETRAGE_OUI = True Then
            Exit Sub
        End If
        Application.Wait Now + TimeValue("00:00:01")
        If i >= 10 Then
            .Timer = "00:" & i
        Else
            .Timer = "00:0" & i
        End If
            .Repaint
    Next i
    
End With
 
Unload UserForm_Parametrage

Application.DisplayAlerts = False

For i = ThisWorkbook.Sheets.Count To 5 Step -1

    Sheets(i).Delete
    
Next i

Application.DisplayAlerts = True

Call Refresh

Call MISE_EN_FORME

Call Calculs_indexations_gasoil

Call Creation_PDF

Call EnvoiMail

Sheets("IMAGES").Visible = False

ThisWorkbook.Save

Application.Quit

End Sub



La partie qui nous intéresse et qui plante est la suivante :


Call Refresh



C'est ce code là qui plante, donc pour bien comprendre, en fait c'est un code qui va chercher des données sur le net. Ensuite des macros s'exécutent pour faire des calculs avec les données récoltées :

Sub Refresh()

  Dim sURL As String: sURL = "URL;http://www.cnr.fr/Indices-Statistiques/Espace-Gazole/Indicateurs-Gazole-France/Prix-CNR-gazole-cuve-moy.-mens#haut"
  '
 ' Ne pas afficher les message d'Excel
 Application.DisplayAlerts = False
  ' En cas d'erreur (suppression requête) on continuer
 On Error Resume Next
  ' Avec la feuille
 With Sheets(1)
    ' Supprimer la requête
   .Cells.QueryTable.Delete
    ' Effacer les cellules
   .Cells.ClearContents
    ' Importer les données web
   With .QueryTables.Add(Connection:=sURL, Destination:=.Range("$A$1"))
      .Name = "Prix-CNR-gazole-cuve-moy.-mens#haut"
      .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
      ' La 4ème table celles des données qui nous intéressent
     .WebTables = "4"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=True
    End With
  End With
     
    Dim sURL2 As String: sURL2 = "URL;http://www.cnr.fr/Indices-Statistiques/Espace-Gazole/Indicateurs-Gazole-France/Prix-gazole-pompe-moy.-mens#haut"
  '
 ' Ne pas afficher les message d'Excel
 Application.DisplayAlerts = False
  ' En cas d'erreur (suppression requête) on continuer
 On Error Resume Next
  ' Avec la feuille
 With Sheets(1)
    ' Importer les données web
   With .QueryTables.Add(Connection:=sURL2, Destination:=.Range("$R$1"))
      .Name = "Prix-gazole-pompe-moy.-mens#haut"
      .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
      ' La 4ème table celles des données qui nous intéressent
     .WebTables = "4"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=True
    End With
  End With
  
End Sub



Sauf que (et c'est là que c'est fou), si je lance le fichier après l'avoir mis sur mon bureau, aucun problème, tout se fait parfaitement. Si je mets le fichier sur mon serveur et que je le lance, les données ne sont pas importées. Donc les calculs donnent 0 :) J'ai pensé à mettre un DoEvents avant de suivre le reste du code. Mais la machine plante et n'importe rien. J'ai la phrase "xxx : lecture des données..." à place du tableau. Une idée? :)

Merci d'avance.

Cordialement.
A voir également:

1 réponse

Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 61
22 juil. 2016 à 16:04
Cette petite ligne posait problème :

.Refresh BackgroundQuery:=True


il faut la mettre en

.Refresh BackgroundQuery:=False


Car sinon, cela permet aux données de s'actualiser en fond de tâche. Ce qui est une erreur, car la machine n'y parvient pas si d'autres procédures sont lancées ensuite.

Cordialement.
0