Probleme en web scrapping

Question

Et merci déjà à ceux qui se pencheront sur mon pb J'attaque un formulaire web internet avec un code vba. Jusque là, assez classique Cependant, quand je modifie un champ du formulaire web par assignation du texte via vba, le champ du formulaire web change, mais il n'est pas pris en considération. Dim nom As String 'mySh est la feuille qui détient les différents enregistrements nom = mySh.Cells(i, colName).Value 'ici je cherche dans le code html du formulaire web le champ prénom Set HTMLButtons = HTMLDoc.all("nom") 'je récupère le bon élément (c'est testé, ça fonctionne) Set HTMLButton = HTMLButtons(1) 'et là je renvoie au formulaire la valeur provenant d'Excel HTMLButton.Value = nom Ainsi, le champ "prénom" a été rempli directement par le formulaire sur internet explorer. On voit que l'étoile devant prénom est en gris Le champ "nom" a été rempli via vba, l'étoile demeure rouge. Je ne peux alors pas valider mon forumulaire. Comment faire pour que le champ "nom" soit aussi considéré comme une vraie entrée ? J'ai essayé en rajoutant un vbCrLf après "nom", mais cela ne fait rien. Comme il s'agit d'un site avec autorisation, je ne peux pas partager tout le code. Merci bcp pour vos lumières...

3GB · Answer

Je ne suis pas chevronné en la matière mais je me suis retrouvé confronté aux mêmes problèmes il y a quelques temps. Donc, de mémoire, je pense aux essais suivants. Première piste à étudier (sûrement pas la bonne) : la simulation d'un clic sur le champ Set HTMLButton = HTMLButtons(1) HTMLButton.click HTMLButton.Value = nom Seconde piste , la temporisation car les actions sur le navigateur peuvent être exécutées en même temps Set HTMLButton = HTMLButtons(1) HTMLButton.Value = nom Call Temporiser 'temporisation avant votre clic/soumission où Temporiser est une procédure d'attente à créer par ailleurs : Sub Temporiser() Application.wait Now + TimeValue("00:00:01")'TimeValue("00:00:01")/10 pour rendre la temporisation plus courte End sub Troisième piste , l'évènement onchange qui déclenche le langage javascript (utile en cas de calcul mais peut-être aussi de validation de données) et qui "simulera" dans certains cas une saisie manuelle Set HTMLButton = HTMLButtons(1) HTMLButton.Value = nom HTMLButton.FireEvent ("onchange") Par ailleurs, pour éviter toute confusion, il serait préférable de nommer autrement vos champs qui ne sont pas des boutons Dim nom As String, prenom as string Dim Champs Dim ChampNom Dim ChampPrenom Dim BoutonConnexion nom = mySh.Cells(i, colName).Value 'prenom = mySh.Cells(i, colName + 1).Value 'c'est une hypothèse Set Champs = HTMLDoc.all("nom") Set ChampNom = Champs(1) Set ChampPrenom = Champs(2) Set BoutonConnexion = HTMLDoc.all("Valider") 'ceci est un exemple ChampNom.Value = nom 'ChampNom.FireEvent ("onchange") 'au cas où ChampPrenom.Value = prenom 'ChampPrenom.FireEvent ("onchange") 'au cas où Call Temporiser BoutonConnexion.Submit '(ou BoutonConnexion.Click si échec) Sinon, un petit essai préalable ne ferait pas de mal avec ChampNom.InnerText = nom...

3GB · Answer

Ah mince ! Est-ce que tu exécutes la macro au pas à pas pour voir ce qu'il se passe ? et voir si tes variables sont correctement affectées (fenêtre variables locales) ? Est-ce que tu pourrais mettre le code en entier ? Pour anonymiser le site, tu peux faire ça : Dim Lien$ Lien = Range("A1").value 'en considérant que la cellule A1 contienne le lien du site ... IE.Navigate Lien...

3GB · Answer

Est-ce que tu as essayé aussi avec HTMLButton.innertext à la place de HTMLButton.value ?

Mais tes identifiants n'apparaissent pas dans le code ? De toute façon, ce qui m'intéresse, c'est le code après la connexion.

Déjà que je ne maitrise pas, alors sans le code, ça serait trop compliqué...

3GB · Answer

Re Jeb,

Bon j'ai apporté de minimes modifications, qui malheureusement n'auront probablement pas l'effet escompté. Mais c'est ce que j'aurais fait naturellement.

Sub addCustomers()

    Dim colName As Integer
    Dim colSurname As Integer
    Dim colInstitute As Integer
    Dim colEmail As Integer
    Dim colTag As Integer
    Dim valDate As Date

    colName = shParametres.Range("valName").Value
    colSurname = shParametres.Range("valSurname").Value
    colInstitute = shParametres.Range("valInstitut").Value
    colEmail = shParametres.Range("valEmail").Value
    colTag = shParametres.Range("valTag").Value
    valDate = shParametres.Range("valDate").Value

    Dim i As Integer
    i = shParametres.Range("startingRow").Value
    Dim mySh As Worksheet
    Set mySh = ActiveWorkbook.ActiveSheet
'--------------------------------------------------------------------------------------------------
'Initialize the internet explorer instance  
    Dim ie As InternetExplorerMedium
    Set ie = New InternetExplorerMedium
    With ie
        .Navigate myLink
        .Visible = True
    End With
    Do While ie.Busy: DoEvents:  Loop

    Dim HTMLDoc As New HTMLDocument
    Set HTMLDoc = ie.Document
'--------------------------------------------------------------------------------------------------
'Get the login/psw
'To obtain username and password

    Dim user As String
    Dim psw As String

    user = InputBox("user")
    psw = InputBox("psw")

'Fill the data
    Dim HTMLElement As MSHTML.IHTMLElement
    Set HTMLElement = HTMLDoc.all("password")
    If (HTMLElement Is Nothing) Then GoTo noPsw
    On Error GoTo noPsw
    HTMLDoc.all.UserName.Value = user
    HTMLDoc.all.Password.Value = psw

    Dim HTMLButtons As MSHTML.IHTMLElementCollection
    Set HTMLButtons = HTMLDoc.getElementsByClassName("btn-submit")
    Dim HTMLButton As MSHTML.IHTMLElement

    Set HTMLButton = HTMLButtons(0)
    HTMLButton.Click

    Do While ie.Busy: DoEvents:  Loop
    Application.Wait (Now() + TimeValue("00:00:03"))
    'Set HTMLDoc = ie.Document
'--------------------------------------------------------------------------------------------------
'Now give the different details
'read each row, if no more data exit, if customer already in the base do not add, else create a new customer
   Do While (True)
        If (mySh.Cells(i, colTag).Value = "") Then
'Case to click
            Set HTMLButtons = HTMLDoc.getElementsByName("new_user")
            Set HTMLButton = HTMLButtons(1)
            HTMLButton.Click
'--------------------------------------------------------------------------------------------------
'C'est à partir de là que je teste tes différentes possibilités ... mais que l'étoile rouge demeure :-)
'Fore name
            Dim prenom As String
            prenom = mySh.Cells(i, colSurname).Value
            Set HTMLButtons = HTMLDoc.all("prenom")
            Set HTMLButton = HTMLButtons(1)
            HTMLButton.Value = prenom
            HTMLButton.FireEvent ("onchange")
'Name
            Dim nom As String
            nom = mySh.Cells(i, colName).Value
            Set HTMLButtons = HTMLDoc.all("nom")
            Set HTMLButton = HTMLButtons(1)
            HTMLButton.Value = nom
            HTMLButton.FireEvent ("onchange")
'institut
            Dim organisme As String
            organisme = mySh.Cells(i, colInstitute).Value
            Set HTMLButtons = HTMLDoc.all("organisme")
            Set HTMLButton = HTMLButtons(1)
            HTMLButton.Value = organisme
            HTMLButton.FireEvent ("onchange")
'Email
            Dim email As String
            email = mySh.Cells(i, colEmail).Value
            Set HTMLButtons = HTMLDoc.all("mail")
            Set HTMLButton = HTMLButtons(1)
            HTMLButton.Value = email
            HTMLButton.FireEvent ("onchange")
'Date
            Dim enddate As Date
            enddate = valDate
            Set HTMLButtons = HTMLDoc.all("end_date")
            Set HTMLButton = HTMLButtons(1)
            HTMLButton.Value = enddate
            HTMLButton.FireEvent ("onchange")

'tempo avant validation

            Application.Wait Now + TimeValue("00:00:01")

'soumission 
            Set HTMLButtons = HTMLDoc.getElementsByClassName("btn btn-primary btn-block ng-binding ng-scope")
            Set HTMLButton = HTMLButtons(0)
            HTMLButton.Click 'HTMLButton.Submit à tester ?

            ie.Navigate monLien
            mySh.Cells(i, colTag).Value = "ok"
        End If
        i = i + 1
        If (mySh.Cells(i, 1).Value = "") Then
            Exit Do
        End If
   Loop

    Set HTMLButton = Nothing
    Set HTMLButtons = Nothing
    Set ie = Nothing
End Sub

Il y a toujours l'option d'essayer avec les sendkeys, c'est-à-dire en simulant les actions du clavier. De mémoire, c'est pas l'idéal. Le mieux serait de se plonger dans les variables et regarder tous les attributs de l'élément HTMLButton (notamment quand il agit sur le nom) pour voir ce qui pourrait bloquer.

Désolé ne pas pouvoir faire davantage (j'espérais que ça marcherait) mais c'est déjà dur en testant soi-même alors sans essayer, c'est compliqué.

Bonne soirée,

3GB · Answer

Eventuellement essayer d'ajouter des petits sleep (fonction kernel32) après les firevent car je crois qu'ils mettent en sommeil l'application (VBA) et permettent de pallier les éventuels problèmes de synchronicité. Car les instructions sont pas forcément exécutées dans l'ordre établi dans le code...