Accélérer Import web trop lent VBA

Bonjour à tous,

J’espère que tout le monde se porte bien.

J'utilise le code ci-dessous pour importer les données d'un site web. Cependant, l'import est très lent et comme je dois répéter cet import de plusieurs pages web vers plusieurs feuilles Excel, je me retrouve avec trop long un temps d’exécution (plusieurs minutes pour 5 Imports).

Je me permets donc de vous solliciter pour essayer de trouver une solution.

Auriez-vous des idées permettant d’accélérer l’exécution de cette macro ?

J'avais pensé à importer le code source de la page web (car j'y retrouve l'information que je cherche), mais je ne sais pas comment faire.

Je vous remercie par avance de votre retour, toujours très précieux.

Vous trouverez ci-dessous le code et ci joint le classeur.

Bien à vous,

Sub MacroImportweb()

Application.ScreenUpdating = False  

    Sheets("Feuil1").Cells.Clear         

    With Sheets("Feuil1").QueryTables.Add(Connection:="URL;http://base-donnees-publique.medicaments.gouv fr/affichageDoc.php?specid=61574515&typedoc=R" _
        , Destination:=Sheets("Feuil1").Range("$A$1"))
        .Name = "importtest"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

Bonjour,

Que souhaites-tu récupérer dans

?

Exemple plus rapide sans doute avec getElementsByTagName("p")

Option Explicit

Sub liste()
Dim page As New HTMLDocument, elem As Object, lig As Integer, contenu As String

    [www].CurrentRegion.Offset(2, 0).ClearContents
    page.body.innerHTML = pageHTML([www])
    lig = 3
    For Each elem In page.getElementsByTagName("p")
        contenu = elem.innerHTML
        contenu = Replace(contenu, "<SPAN style=""FONT-FAMILY: Symbol"">·<SPAN style='FONT: 7pt ""Times New Roman""'> </SP", "")
        contenu = Replace(contenu, "AN></SPAN>", "")
        contenu = Replace(contenu, "<SPAN style=""FONT-SIZE: 10pt; FONT-FAMILY: Arial"">", "")
        If InStr(contenu, "name") Then
            Cells(lig, 1) = Split(Split(contenu, ">")(1), "<")(0)
        Else
            Cells(lig, 1) = contenu
        End If
        lig = lig + 1
    Next elem

Exit Sub

End Sub

Function pageHTML(url As String) As String
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", url, False
        .send
        pageHTML = .responseText
    End With
End Function

Bonjour,

Merci pour vos réponses.

Voici le fichier correct.

Je souhaite uniquement récupérer:

ANSM - Mis à jour le : xxxx

et

DENOMINATION DU MEDICAMENT

xxxx

(avec xxxx variables bien sûr).

Ll'option getElementsByTagName("p") fonctionne bien et est bien plus rapide en effet. Je peux, à partir de ça, ressortir les informations que je cherche très rapidement.

cordialement,

Dans ce cas il y a encore beaucoup plus simple et plus rapide !

Si tu as toute une liste, donne deux ou trois adresses et je mettrais ceci en boucle.

Option Explicit

Sub liste()
Dim contenu$, avant$, apres$

    [www].CurrentRegion.Offset(2, 0).ClearContents
    contenu = pageHTML([www])
    avant = "ANSM": apres = "</p>"
    Cells(3, 1) = avant & Split(Split(contenu, avant)(1), apres)(0)
    avant = "<p class=AmmCorpsTexteGras>": apres = "</p>"
    Cells(4, 1) = Split(Split(contenu, avant)(1), apres)(0)

End Sub

Function pageHTML(url As String) As String
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", url, False
        .send
        pageHTML = .responseText
    End With
End Function

c'est génial !

j'ai mis 2 adresses dans les feuilles 2 et 3 en A2.

merci encore !

Il suffit de mettre les références colonne A

C'est parfait!

merci beaucoup!