Boucle et variables sur fonction "querytables.add("

Le 06/10/2012 à 12:55

Bonjour à tous,

J'essaye de récupérer les données contenu dans un tableau multipages sur internet à l'aide de l'import de donnée Web d'Excel. Fonction VBA querytables.add(.

Pour se faire :

J'ai enregistré la macro récupérant les données du tableau de la 1ère page. Ce qui me donne ci-dessous mon code de départ.

Sub Macro1()
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.site.com/annuaire.php?&page=0" _
        , Destination:=Range("$A$1"))
        .Name = _
         "annuaire.php?&page=0"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = "11"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Sur excel en feuille 1, j'ai créé une formule pour reconstituer les adresses de toutes les pages du tableau. Ce qui me donne :

Col. A______Col. B 
Page_______URL
1__________http://www.site.com/annuaire.php?&page=0
2__________http://www.site.com/annuaire.php?&page=1
3__________http://www.site.com/annuaire.php?&page=2 
4__________http://www.site.com/annuaire.php?&page=3
...

Maintenant, j'aimerais faire évoluer le code pour :

  • > Aller chercher les urls dans la colonne B de la feuille 1
  • > Ramener les résultats dans la feuille 2,
  • > De savoir faire une boucle pour récupérer les résultats de l'URL 1 puis 2 puis 3, etc.. jusqu'à ce que la première cellule vide de la colonne des URL soit rencontrée.
  • > Les résultats doivent se mettre les uns en dessous des autres dans la feuille2.

Est-ce que quelqu'un pourrait m'aider à faire ça ?

Je pense que cela ne doit pas être bien compliqué mais je n'ai que de petites connaissances en VBA...

Merci à tous pour votre aide.

Cordialement,

Mathieu.

Le 06/10/2012 à 13:16

Salut Mathieu

Tu pourras essayer ce code, n'ayant pas l'url exacte, je ne peux pas

Sub ImportRqtWeb()
  Dim DLig As Long, Lig As Long, sht As Worksheet, sURL As String
  Dim NLig As Long
  ' Définir la feuille de données
  Set sht = Sheets("Feuil1")
  ' Récupérer la dernière ligne du tableau
  DLig = sht.Range("B" & Rows.Count).End(xlUp).Row
  ' Boucler sur tout le tableau
  For Lig = 1 To DLig
    ' récupérer l'url de la ligne
    sURL = sht.Range("B" & Lig)
    ' Sur la feuille 2
    With Sheets("Feuil2")
      ' Rouver la prochaine ligne vide
      NLig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
      ' Insérer la requête web
      With .QueryTables.Add(Connection:="URL;" & sURL, Destination:=.Range("$A$" & NLig))
        .Name = "annuaire.php?&page=" & Mid(sURL, InStr("1", sURL, "=") + 1)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = "11"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
      End With
    End With
  Next Lig
End Sub

A+

Le 06/10/2012 à 14:28

Bonjour Bruno,

Merci beaucoup pour votre aide.

Lorsque je lance le code il y a un bug qui m'est indiqué à ce niveau :

 With .QueryTables.Add(Connection:=sURL, Destination:=.Range("$A$" & NLig)) _
           .Name = "annuaire.php?&page=" & Mid(sURL, InStr("1", sURL, "=") + 1)

Il faut peut être simplier Name =.. ?

Pour avoir un exemple vous pouvez par exemple essayer avec les 2 adresses suivantes:

Pour que ça marche avec ce site il faudra par contre modifier la liste des paramètres de la fonction avec ceux ci-dessous :

        .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

Merci encore pour votre aide.

Mathieu.

Le 06/10/2012 à 16:16

Re,

Désolé, il y avait effectivement 2 erreurs dans mon code que j'ai rectifié

1) Il faut supprimer le underscore de

With .QueryTables.Add(Connection:=sURL, Destination:=.Range("$A$" & NLig))

2) Il faut ajouter le type de connection

With .QueryTables.Add(Connection:="URL;" & sURL, Destination:=.Range("$A$" & NLig))

A+

Le 15/04/2016 à 09:27

Bonjour,

J'ai utilisé le m^me code pour récupérer une partie d'une feuille HTML mais bizarrement, ça ne fonctionne plus au bout de quelques jours... il faut alors que je refasse manuellement l'opération pour que le code refonctionne de nouveau.

Précision : Il faut que l'utilisateur saisisse son identifiant et mot de passe pour afficher la page Web.

Une idée ?

Voici le code que j'utilise :

    With Sheets("TEMP").QueryTables.Add(Connection:= _
        "URL;" & adr _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "Pretty%20Print"
        .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 = "2,5"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Rechercher des sujets similaires à "boucle variables fonction querytables add"