Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 EXCEL VBA chercher text precis sur Internet

pasquetp

XLDnaute Occasionnel
Bonjour,


je travaille sur un projet pour mon chef.

l'objectif est de déterminer pour une liste de suivi ( UPS) s'ils sont livrés et ce manière automatique et non visuel par l'utilisateur

je vous donne un exemple


on constate qu'il est livré


j'aimerai que VBA ou autrement , que la verification puisse etre automatisé

j'ai tenté de telecharger avec la web query: il me fait patienter une eternité et j'obtiens au final un echec de tentative

"connexion impossible, nous avons rencontré une erreur lors de la tentztive de connexion , etc

=====================================================

seconde tentative: j'ai egalement tenté ce module sauf qu'il cherche indefiniment


Sub Basic_Web_Query()

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.ups.com/track?track=yes&trackNums=1ZA30A810309584769&loc=en_US&requester=ST/trackdetails", Destination:=Range("$A$1"))
.Name = "q?s=goog_2"
.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 = "1,2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End Sub
===============================

je suis a court d'idée. quelqu'un aurait une idée pour m'aider?

merci

Pierre
 
Dernière édition:

crocrocro

XLDnaute Impliqué
Bonjour Pierre,
même problème que toi (délai dépassé) avec ce code (ici pour le calcul de distance et durée entre 2 villes qui lui fonctionne bien).

VB:
Public Const DIST = "http://www.distance2villes.com/recherche?source="
Sub Distance()
Dim lg As Integer, i As Integer
Dim Url As String, Txt As String

    With Sheets(1)
        lg = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To lg
            Url = DIST & .Range("A" & i).Value & "&destination=" & .Range("B" & i).Value
            With CreateObject("WINHTTP.WinHTTPRequest.5.1")
                .Open "GET", Url, False
                .send
                Txt = .responseText
            End With
            .Range("C" & i).Value = Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0)
            .Range("D" & i).Value = Split(Split(Txt, "id=""tiempo"">")(1), "</span>")(0)
        Next i
    End With
End Sub

Pour la suite, si tu arrives à résoudre le problème de délai dépassé :
La fonction Split permet de localiser l'information à récupérer sur le code source de la page (à adapter donc).
Pour l'automatisation, une exécution de la macro planifiée avec OnTime pour toutes les requêtes de suivi courantes.
Désolé de ne pouvoir apporter plus.
 

pasquetp

XLDnaute Occasionnel
merci a vous , j'avais pas du tout pensé sous cet angle. on pensait initialement recuperer les resultats de plusieurs suivi avec pour objectif identifier les retards et agir dessus. c'est par cette optique que cela ne nous a pas effleuré. je pense que je vais contacvter UPS pour savoir s'il y a des outils autorisé pour les entreprises car on envoie bcp de colis via UPS et le suivi ca fait parti de notre taff

merci a vous
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…