Importer des données du web - parcourir une liste d'URL

Le 07/10/2013 à 19:24

Bonjour,

Je souhaite récupérer à partir du site "

" les fiches techniques de certains téléphones mobiles.

En m'inspirant du très bon post + vidéo intitulée "créer une macro pour Importer des données d'un site web", j'ai donc écrit le code ci-dessous, qui me permet de récupérer sur 3 colonnes: la marque, le nom du mobile et le lien hyper texte de la fiche technique.

Je bloque pour l'étape d'après, qui consisterait à l'aide d'une nouvelle macro à parcourir la colonne 3 des liens hyper texte récupérés précédemment et d'importer chacune de ces fiches techniques. Je souhaiterai automatiser ce processus et pas le faire manuellement.

Ps: c'est ma 1ère macro excel!!!

Ps2: c'est mon 1er post sur ce forum!!!

Merci pour votre aide,

Bonne fin de journée,

Sub Importer2()

Sheets("Temp").Cells.Clear

With Sheets("temp").QueryTables.Add(Connection:= _

"URL;http://www.tudocelular.com/celulares/fichas-tecnicas.html", Destination _

:=Sheets("temp").Range("$A$1"))

.Name = "fichas-tecnicas"

.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

compteur = 0

For ligne = 1 To 1000

If Right(Sheets("temp").Cells(ligne, 1), 2) = "ço" Or Right(Sheets("temp").Cells(ligne, 1), 2) = "R$" Or Right(Sheets("temp").Cells(ligne, 1), 3) = "dos" Then

compteur = compteur + 1

Sheets("accueil").Cells(compteur, 1) = Sheets("temp").Cells(ligne - 3, 1)

Sheets("accueil").Cells(compteur, 2) = Sheets("temp").Cells(ligne - 2, 1)

Sheets("accueil").Cells(compteur, 3) = Sheets("temp").Cells(ligne - 3, 1).Hyperlinks(1).Address

If compteur = 24 Then Exit For

End If

Le 07/10/2013 à 20:51

bonsoir,

voici un exemple qui consulte les pages mentionnées en colonne C. à toi d'adapter le code pour copier les cellules qui t'intéressent.

Sub Importer2()

Sheets("Temp").Cells.Clear

With Sheets("temp").QueryTables.Add(Connection:= _
"URL;http://www.tudocelular.com/celulares/fichas-tecnicas.html", Destination _
:=Sheets("temp").Range("$A$1"))
.Name = "fichas-tecnicas"
.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
compteur = 0

For ligne = 1 To 1000

If Right(Sheets("temp").Cells(ligne, 1), 2) = "ço" Or Right(Sheets("temp").Cells(ligne, 1), 2) = "R$" Or Right(Sheets("temp").Cells(ligne, 1), 3) = "dos" Then
compteur = compteur + 1
Sheets("accueil").Cells(compteur, 1) = Sheets("temp").Cells(ligne - 3, 1)
Sheets("accueil").Cells(compteur, 2) = Sheets("temp").Cells(ligne - 2, 1)
Sheets("accueil").Cells(compteur, 3) = Sheets("temp").Cells(ligne - 3, 1).Hyperlinks(1).Address

If compteur = 24 Then Exit For
End If

Next
Set wsa = Worksheets("Accueil")
Set ws = Worksheets("querydetails")
For i = 1 To 24
    For Each qt In ws.QueryTables
               qt.Delete
    Next qt
    With ws.QueryTables.Add(Connection:= _
        "URL;" & Worksheets("Accueil").Cells(i, 3) _
        , Destination:=ws.Range("$A$1"))
        .Name = "RIM-BlackBerry-Z30"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
' copie les infos qui t'intéresses
    wsa.Cells(i, 4) = ws.Cells(29, 1)

Next i
End Sub

Le 07/10/2013 à 21:26

Merci beaucoup, ça marche!

Si je comprends bien le processus pour pouvoir le refaire moi même.

Tu enregistre une nouvelle macro sur un des liens, puis tu automatises d'une part en créant une boucle "i" et d'autre part en remplaçant l'adresse URL par "URL;" & Worksheets("Accueil").Cells(i, 3).

Néanmoins, étant totalement néophyte, que signifie qt?

Merci encore,

))

Le 07/10/2013 à 21:43

bonsoir,

qt est le nom d'une variable destinée à contenir une QueryTable (qt).

pour éviter des problèmes de mémoire et stabilité d'excel, je nettoie les queries dont on n'a plus besoin.

Le 07/10/2013 à 21:52

OK merci de ton aide.

Bonne soirée

Le 08/10/2013 à 22:41

Bonsoir, suite à l'aide de H2SO4, j'ai pu construire la macro qui me permet de récupérer les prix (colonne D) pour chaque téléphone sur le site tudocelular.com.br. Ci-dessous le code.

Je souhaiterai pouvoir conserver l'historique de ces prix en fonction de la mise à jour de la macro. Par exemple, si je relance la macro dans une semaine, je voudrai conserver les prix d'aujourd'hui et ainsi constituer un historique de prix.

Débutant je ne sais pas comment faire,

Merci pour votre aide,

Sub Importer2()

Sheets("Temp").Cells.Clear

Sheets("querydetails").Cells.Clear

With Sheets("temp").QueryTables.Add(Connection:= _

"URL;http://www.tudocelular.com/celulares/fichas-tecnicas.html", Destination _

:=Sheets("temp").Range("$A$1"))

.Name = "fichas-tecnicas"

.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

compteur = 0

For ligne = 1 To 1000

If Right(Sheets("temp").Cells(ligne, 1), 2) = "ço" Or Right(Sheets("temp").Cells(ligne, 1), 2) = "R$" Or Right(Sheets("temp").Cells(ligne, 1), 3) = "dos" Then

compteur = compteur + 1

Sheets("accueil").Cells(compteur, 1) = Sheets("temp").Cells(ligne - 3, 1)

Sheets("accueil").Cells(compteur, 2) = Sheets("temp").Cells(ligne - 2, 1)

Sheets("accueil").Cells(compteur, 3) = Sheets("temp").Cells(ligne - 3, 1).Hyperlinks(1).Address

If compteur = 24 Then Exit For

End If

Set wsa = Worksheets("Accueil")

Set ws = Worksheets("querydetails")

For i = 1 To 24

For Each qt In ws.QueryTables

qt.Delete

Next qt

With ws.QueryTables.Add(Connection:= _

"URL;" & Worksheets("Accueil").Cells(i, 3) _

, Destination:=ws.Range("$A$1"))

.Name = "RIM-BlackBerry-Z30"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.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

For ligneA = 1 To 1000

If Left(ws.Cells(ligneA, 1), 7) = "Especif" Then

wsa.Cells(i, 4) = ws.Cells(ligneA + 11, 1)

Exit For

End If

Next i

End Sub

Rechercher des sujets similaires à "importer donnees web parcourir liste url"