Impossible d'extraire certaines données
En fait la page principale est https://www.airlines-manager.com et elle renvoie une fois logué vers https://www.airlines-manager.com/login_check qui renverra ensuite vers https://www.airlines-manager.com/home si c'est ok
Donc voici la procédure qui devrait te donner les informations par une identification directe sur le site
Sub RELEVER()
Dim texte As String
'login
'texte = [form_login].Text
texte = HtmlGet(Cells(1, 2).Value)
Cells(7, 2) = HiddenInput(texte)
'interro
'texte = [extrait_web].Text
texte = HtmlPost(Cells(2, 2).Value, Cells(8, 2).Value)
For i = 11 To 14
Cells(i, "G") = ChercheChaine(QuadriSplit(texte, Cells(i, "B"), Cells(i, "C"), Cells(i, "D"), Cells(i, "E")), Cells(i, "F"))
Next
End Sub
Function HtmlGet(URL As String) As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
HtmlGet = .responseText
End With
End Function
Function HtmlPost(URL As String, param As String) As String
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send param
HtmlPost = .responseText
End With
End Function
Function DoubleSplit(texte As String, debut As String, fin As String)
DoubleSplit = Split(Split(texte, debut)(1), fin)(0)
End Function
Function QuadriSplit(texte As String, debut1 As String, fin1 As String, debut2 As String, fin2 As String)
QuadriSplit = Split(Split(texte, debut1)(1), fin1)(0)
QuadriSplit = Split(Split(QuadriSplit, debut2)(1), fin2)(0)
End Function
Function ChercheChaine(chaine, pattern)
Set obj = CreateObject("vbscript.regexp")
obj.pattern = pattern
Set a = obj.Execute(chaine)
If a.Count > 0 Then ChercheChaine = a(0) Else ChercheChaine = ""
End Function
Function HiddenInput(texte As String) ' parametres POST
Dim entrees() As String, noms, valeurs, i, chaine
chaine = ""
avant = "<input type=""hidden"""
apres = ">"
entrees = Split(texte, avant)
For i = 1 To UBound(entrees) ' le 0 est avant le début, donc ne pas tenir compte !
noms = DoubleSplit(entrees(i), "name=""", """")
valeurs = DoubleSplit(entrees(i), "value=""", """")
chaine = chaine & "&" & noms & "=" & valeurs
Next
HiddenInput = chaine
End FunctionAïe aïe aïe aïe ! non pas ça !! ah non je ne suis pas au top !Merci Steelson tu es top !
1 ) C'est une authentification par Facebook, mais je n'utilise pas cette option, je prends l'authentification basique avec mail et mdp
Impossible de savoir comment facebook transmet les informations de connexion !! de plus (j'ai essayé) les identifiants via fb ne sont pas utilisables pour une connexion directe. Là on atteind les limites
Quand je vais sur Excel
Données -> A partir du web -> je copie colle le lien -> il ouvre une fenêtre ou j'ai 2 onglets "Affichage table" et "Affichage web"
Dans table j'ai ce que je t'ai copié collé et dans web la page.
Sauf que pour me connecter j'ai utilisé une vielle extraction que j'avais sur un ancien fichier, qui date d'avant Excel 2016 qui n'avait pas Power Query.
Du coup j'imagine qu'Excel a gardé en mémoire mes cookies.
Je te joins l'ancien fichier si tu veux sur l'onglet DataPrixBillet tu auras la connexion d'active
Le fichier m'indique une erreur sur
Sheets("ROI").Activatecar la feuille ROI n'existe pas.
Je ne pense pas que ce soit important ... sauf si cette page contenait une macro permettant de s'identifier (mais même du reste je ne vois pas comment elle fonctionnerait !
Je reste donc perplexe, car rien ne permet de s'identifier dans Module1.
J'ai aussi compléter le minisite pour faire appel aux cookies. Quelque soit le navigateur utilisé pour "déposer" le cookie, excel ne permet pas la lecture d'une page qui le récupérerait, que ce soit via
PowerQuery,
QueryTables.Add,
CreateObject("MSXML2.XMLHTTP")
ou encore WebBrowser1.Navigate
sauf ...
La seule méthode est CreateObject("InternetExplorer.Application") à partir d'excel.
La seule méthode est CreateObject("InternetExplorer.Application") à partir d'excel.
Donc si la connexion reste active via Internet Explorer, tu peux récupérer la page affichée comme ceci :
- l'URL est indiquée dans Sheets("Feuil1").Range("A1").Value
- les informations d'afficheront dans Sheets("Feuil2")
Sub Demo()
Sheets("Feuil2").Select
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate Sheets("Feuil1").Range("A1").Value
Do Until .ReadyState = 4 And .Busy = False: DoEvents: Loop
With .Document
Do: Loop Until .ReadyState = "complete"
Debug.Print "ok"
End With
SendKeys "^a"
SendKeys "^c"
Application.Wait Now + TimeValue("0:00:01")
.Quit
End With
Sheets("Feuil2").Paste
End SubJe te remercie Steelson.
En fait, tu n'avais pas besoin de lancer la macro en te mettant sur la cellule A1 tu faisais clique droit, actualisé et ça te mettait à jour l'extraction.
Mais si tu n'as pas le cookie dans ton PC en effet il doit falloir se connecter au moins une fois, mais avec le navigateur intégré dans Excel tu peux le faire très facilement puisque tu arrives sur la page de connexion si cookie non actif, tu mets tes logs et hop c'est ok.
En version VBA c'est le code ci-dessous :
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.airlines-manager.com/aircraft/show/23651824" _
, Destination:=Range("$A$1"))
.Name = "DataCoutRevenuAux"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.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 WithSauf que j'ai une mise en forme toute moche et pas super fonctionnelle que je suis obligé de retraiter pour que ça me fasse des datas exploitables.
Mais bon tant pis ça fera l'affaire, j'espère juste que cette méthode ne va pas disparaitre vu que c'est en lien avec IE et probablement qu'un jour MS le supprimera...
Merci pour le code qui extrait une page, en l'état je m'en servirai pas pour le besoin d'extraction de mes avions, mais je vais pouvoir récupérer d'autres infos avec les liens HTML qui m'indique le numéro incrémenté à chaque fois qu'un joueur achète un avion
En tout cas merci pour ton aide.
Je te souhaite un bon réveillon !
merci, j'ai au moins appris une chose !En fait, tu n'avais pas besoin de lancer la macro en te mettant sur la cellule A1 tu faisais clique droit, actualisé et ça te mettait à jour l'extraction.
Je reste perplexe car sur mon minisite il ne tient pas compte du cookie ... je vais continuer mes investigations !Mais si tu n'as pas le cookie dans ton PC en effet il doit falloir se connecter au moins une fois, mais avec le navigateur intégré dans Excel tu peux le faire très facilement puisque tu arrives sur la page de connexion si cookie non actif, tu mets tes logs et hop c'est ok.
Est-ce que cela veut dire qu'une fois logué via fb tu as accès aux informations ?
En tout cas merci pour ton aide.
de rien, je ne pense pas avoir relevé le défi à 100% mais si cela a fait avancer le schmilblick
de mon côté cela m'a permis de progresser
idem, pas d'excèsJe te souhaite un bon réveillon !
Non mais je ne me log pas via FB, mais en connexion normale avec un compte via le site, juste avec mon @mail et mon mdp
donc ceci doit fonctionner alors https://forum.excel-pratique.com/viewtopic.php?p=720209#p720209 moyennant peut-être quelques réglages !