Je cherche à télécharger des fichiers issus de requêtes.
Je m'explique. J'ai un fichier Excel qui contient des URL qui donne des itinéraires sur google maps.
-Colonne A : l'URL de Google Maps
-Colonne B : identifiant de l'itinéraire mais également nom du futur fichier de sortie.
Mes liens fonctionnent et me donnent bien mon itinéraire entre chaque point d'origine et de destination.
J'envoie ce lien sur un site qui le transforme en trace (itinéraire) avec l'extension .gpx
L'objectif étant par la suite de visualiser ces itinéraires dans un logiciel SIG.
Je vous mets le code que j'ai bâti en compilant plusieurs sources.
ça fonctionne quasiment, c'est juste la boucle qui ne fonctionne pas car j'aimerais que la requête traite les éléments des cellules A1 et B1 puis A2 et B2.
Là, la boucle
Contenu fictif du tableur :
A1 :
https://www.google.fr/maps/dir/43.8487866,4.044672/43.678598,3.42908/@44.52632,5.3766603,11z/data=!3m1!4b1!4m5!4m4!2m3!6e1!7e2!8j1637257600
B1 : 1
A2 :
https://www.google.fr/maps/dir/43.8122498,4.3535414/43.5385473,3.4440034/@43.7286049,3.1926774,9z/data=!4m6!4m5!2m3!6e1!7e2!8j1637257600!3e0
B2 : 2
A3 : URL... B3 : 3
Code
Sub fichiergpx()
Dim ReQ As Object, ie As Object
Dim TheCellURL As Range
Dim TheCellNumeroSalarie As Range
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "http://www.gpsvisualizer.com/convert_input"
ie.Visible = True
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Loca = ie.LocationURL
With Feuil1
'On boucle sur les cellules de la colonne A
For Each TheCellURL In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
ie.document.getElementById("convert_format:gpx").Checked = True
ie.document.getElementById("remote_data_input").Value = TheCellURL.Value
ie.document.getElementsByName("submitted")(0).Click
Do: DoEvents: Loop Until ie.LocationURL <> Loca
Application.SendKeys "{ENTER}" 'au cas ou l'explorer demande de cliquer sur le message de changement de page
Set tds = ie.document.getElementsByTagName("td")
For i = 0 To tds.Length - 1
If tds(i).getElementsByTagName("iframe").Length > 0 Then
If InStr(tds(i).getElementsByTagName("iframe")(0).src, "-data.gpx") > 0 Then linkfichier = tds(i).getElementsByTagName("iframe")(0).src
End If
Next
'Les erreurs ne sont pas gérées
On Error Resume Next
With Feuil1
'On boucle sur les cellules de la colonne B
For Each TheCellNumeroSalarie In .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
'On lui donne le chemin du fichier, son nom et l'extension
chemin = ThisWorkbook.Path & "\" & TheCellNumeroSalarie.Value & ".gpx"
Set ReQ = CreateObject("Microsoft.XMLHTTP")
ReQ.Open "get", linkfichier, False
ReQ.send
x = FreeFile
Open chemin For Output As #x
Print #x, Replace(ReQ.responseText, ">", ">" & vbCrLf),
Close #x
ie.Quit
Next
End With
Next
End With
End Sub
Je vous remercie par avance.
A voir également:
Téléchargement d'un fichier dont l'URL est dynamique - Boucle défectueuse
bonjour,
je ne comprends pas pourquoi tu fais une boucle sur les cellules de la colonne B, ne suffit-il pas de prendre la cellule à droite de la cellule en colonne A?
La solution était bien là.
c'est donc résolu.
Il fallait quand même déplacer un bloc du départ afin que tout fonctionne parfaitement.
Merci bien dans tous les cas yg_be