Importer une page web dans un onglet, avec une boucle

betteggan

XLDnaute Nouveau
Bonjour à tous,

j 'ai une feuille "basemondiale" qui est notamment constituée d'une colonne I avec des adresses url.

Je cherche à faire une macro permettant d'importer chacune de ces adresses url dans une feuille TEMP.

MON QUERRY TABLE ne fonctionne pas dans ma boucle.

si kkun pouvait m'aider à faire en sorte que l'importation se fasse, je lui en serai très reconnaissant.

voici une copie de mon code :

Sub MacroTRAJET()

Dim DLig As Long, Lig As Long, sht As Worksheet, sURL As String
Dim NLig As Long
Dim IE As InternetExplorer

Delay = Sheets("basemondiale").[L1].Value
If Delay = 0 Then Delay = 15
'(si la cellule L1 de la feuille "basemondiale"est vide, alors le delay sera de 15 secondes)

Dim Start As Single

' Définir la feuille de données
Set sht = Sheets("basemondiale")

' Récupérer la dernière ligne de la feuille de données
DLig = sht.Range("I" & Rows.Count).End(xlUp).Row


' Boucler sur tout le tableau
For Lig = 2 To 1085
' récupérer l'url de la ligne dans la feuille "basemondiale" (la feuille de données)
sURL = sht.Range("I" & Lig)

' on ouvre internet explorer
Set IE = New InternetExplorer
IE.Visible = True
Application.DisplayAlerts = False

Debug.Print IE.readyState
IE.navigate sURL
'Attendre que la page désirée dont l'adresse est dans la base soit prete
While IE.readyState <> READYSTATE_COMPLETE
Wend


'Timer (Wait ralenti les autres appli) pour donner le temps de faire l'importation
Start = Timer + Delay ' pour 15 secondes
While Timer < Start
DoEvents
Wend


' Insérer PAR IMPORTATION la requête web dans feuille TEMP
' Sur la feuille TEMP



With Sheets("TEMP").QueryTables.Add(Connection:="URL;" & sURL, Destination:=Sheets("TEMP").Range("$A$1"))
.Name = False
.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

'Fermer le navigateur
IE.Quit
IEfermerOuErreur:
Set IE = Nothing
Application.DisplayAlerts = True

End With











With Sheets("LIGNE50")
' Trouver la prochaine ligne vide
NLig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
End With



Next Lig


End Sub
 

Roland_M

XLDnaute Barbatruc
Re : Importer une page web dans un onglet, avec une boucle

bonsoir,

j'ai ceci si ça peut t'aider pour comparer ... !?
je m'en suis servi pour faire des essais et ça fonctionnait.

Code:
With ActiveSheet.QueryTables.Add(Connection:=URL$ & Trim(NoPage), Destination:=Cells(DernLig, 1)) 'Range("$A$" & Trim(DernLig)))
    '.CommandType = 0
    .Name = "" 'le nom de la QueryTables
    .FieldNames = False 'affiche les entêtes de lig/col(titre des champs)
    .RowNumbers = False
    .FillAdjacentFormulas = False 'Active le recalcul
    .PreserveFormatting = False
    .RefreshOnFileOpen = False  'Rafraichit la connexion quand on ouvre le classeur
    .BackgroundQuery = False    'Rafraichissement en arrière-plan
    .RefreshStyle = xlOverwriteCells 'xlOverwriteCells > pour ne pas effacer les lectures précédantes
    .SavePassword = False
    .SaveData = False
    .AdjustColumnWidth = False
    .RefreshPeriod = 0 'Période rafraichissement auto 1min minimum

    'Pour sélectionner des données, selon la recherche sur le site !?
    .WebSelectionType = xlEntirePage        '(toute la Page)

   '.WebSelectionType = xlSpecifiedTables   'tables(tableaux)
   '.WebTables = "2,3"                      'Les tables à sélectionner
    
    .WebFormatting = xlWebFormattingAll 'xlWebFormattingAll > pour importer toute la mise en forme
    .WebPreFormattedTextToColumns = True 'ici true pour garder les col(exp avec les chansons les durées sont dans col(C)
    .WebConsecutiveDelimitersAsOne = False
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False 'Rapatrie les données / en bloquant le programme
    .Delete                         'emploi unique de la connexion suppr aussitôt
End With
 

Lone-wolf

XLDnaute Barbatruc
Re : Importer une page web dans un onglet, avec une boucle

Bonsoir betteggan,

Pour commencer, ça serait bien de joindre le fichier.
' récupérer l'url de la ligne dans la feuille "basemondiale" (la feuille de données)
sURL = sht.Range("I" & Lig)

On ne peut quand même pas inventer ces URLS.

Ensuite pour une meilleure lisibilité du code, clique sur le bouton "Aller en mode avancé", tu as l'icône #, clique dessus, et entre les deux CODE en encadré tu colle la macro. Tu peux aussi faire comme ceci

Code:
 sans enlever les crochet bienentendu.



A+ :cool:
 
Dernière édition:

betteggan

XLDnaute Nouveau
Re : Importer une page web dans un onglet, avec une boucle

Rebonsoir,


Merci Roland, je vois regarder ton code.


je reposte mon code, je ne savais pas ce qu'était que le mode avancé. et je met un lien pour accéder au fichier

bien cordialement,


https://up2.1fichier.com/end.pl?xid=cdbPglXfoI


Code:
Sub MacroTRAJETbasemondiale()

  Dim DLig As Long, Lig As Long, sht As Worksheet, sURL As String
  Dim NLig As Long
  Dim IE As InternetExplorer
  
  Delay = Sheets("basemondiale").[L1].Value
  If Delay = 0 Then Delay = 13
  '(si la cellule L1 de la feuille "basemondiale"est vide, alors le delay sera de 13 secondes)
  
  Dim Start As Single
  
  ' Définir la feuille de données
  Set sht = Sheets("basemondiale")
  
  ' Récupérer la dernière ligne de la feuille de données
  DLig = sht.Range("I" & Rows.Count).End(xlUp).Row
  
  
  ' Boucler sur tout le tableau
   For Lig = 2 To 1085
   ' Nettoyer la mémoire
   Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8"
   
     ' récupérer l'url de la ligne dans la feuille "basemondiale" (la feuille de données)
    sURL = sht.Range("I" & Lig)
    
    ' on ouvre internet explorer
     Set IE = New InternetExplorer
      IE.Visible = True
      Application.DisplayAlerts = False
      
      Debug.Print IE.readyState
        IE.navigate sURL
        'Attendre que la page désirée dont l'adresse est dans la base soit prete
      While IE.readyState <> READYSTATE_COMPLETE
      Wend
      
      
      'Timer (Wait ralenti les autres appli) pour donner le temps de faire l'importation
        Start = Timer + Delay ' pour 15 secondes
        While Timer < Start
            DoEvents
        Wend
      
      
      ' Insérer PAR IMPORTATION la requête web dans feuille TEMP
      ' Sur la feuille TEMP
    
       
        
         With Sheets("TEMP")
      ' Trouver 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 = sURL
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebTables = "2,3"
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=True
    End With
       
        
        
        'Fermer le navigateur
        IE.Quit
IEfermerOuErreur:
    Set IE = Nothing
    Application.DisplayAlerts = True
        
            End With

    
    Next Lig
        
 
   
  
End Sub
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 107
dernier inscrit
cdel