使用vba登录网站 - 单击提交时，un和pw消失

Question

我正在尝试编写一个只需登录this网站的宏。

我以前做了一些网络抓取，并且总是能够在其他网站上成功地做类似的事情，但我无法弄清楚这个。

我已经尝试了很多东西，最后一次尝试（非常绝望！）是输入用户名和密码，并调用所有可能的脚本并触发所有可能的事件，请参阅下面的代码。请忽略我如何命名/命名某些东西（比如eventsArray的集合等） - 我不断尝试新事物并多次更改代码，这都是暂时的。

    Dim eventsArray As New Collection
    eventsArray.Add "abort"
    eventsArray.Add "afterprint"
    eventsArray.Add "animationend"
    eventsArray.Add "animationiteration"
    eventsArray.Add "animationstart"
    eventsArray.Add "beforeprint"
    eventsArray.Add "beforeunload"
    eventsArray.Add "blur"
    eventsArray.Add "canplay"
    eventsArray.Add "canplaythrough"
    eventsArray.Add "change"
    eventsArray.Add "click"
    eventsArray.Add "contextmenu"
    eventsArray.Add "copy"
    eventsArray.Add "cut"
    eventsArray.Add "dblclick"
    eventsArray.Add "drag"
    eventsArray.Add "dragend"
    eventsArray.Add "dragenter"
    eventsArray.Add "dragleave"
    eventsArray.Add "dragover"
    eventsArray.Add "dragstart"
    eventsArray.Add "drop"
    eventsArray.Add "durationchange"
    eventsArray.Add "ended"
    eventsArray.Add "error"
    eventsArray.Add "focus"
    eventsArray.Add "focusin"
    eventsArray.Add "focusout"
    eventsArray.Add "fullscreenchange"
    eventsArray.Add "fullscreenerror"
    eventsArray.Add "hashchange"
    eventsArray.Add "input"
    eventsArray.Add "invalid"
    eventsArray.Add "keydown"
    eventsArray.Add "keypress"
    eventsArray.Add "keyup"
    eventsArray.Add "load"
    eventsArray.Add "loadeddata"
    eventsArray.Add "loadedmetadata"
    eventsArray.Add "loadstart"
    eventsArray.Add "message"
    eventsArray.Add "mousedown"
    eventsArray.Add "mouseenter"
    eventsArray.Add "mouseleave"
    eventsArray.Add "mousemove"
    eventsArray.Add "mouseover"
    eventsArray.Add "mouseout"
    eventsArray.Add "mouseup"
    eventsArray.Add "mousewheel"
    eventsArray.Add "offline"
    eventsArray.Add "online"
    eventsArray.Add "open"
    eventsArray.Add "pagehide"
    eventsArray.Add "pageshow"
    eventsArray.Add "paste"
    eventsArray.Add "pause"
    eventsArray.Add "play"
    eventsArray.Add "playing"
    eventsArray.Add "popstate"
    eventsArray.Add "progress"
    eventsArray.Add "ratechange"
    eventsArray.Add "resize"
    eventsArray.Add "reset"
    eventsArray.Add "scroll"
    eventsArray.Add "search"
    eventsArray.Add "seeked"
    eventsArray.Add "seeking"
    eventsArray.Add "select"
    eventsArray.Add "show"
    eventsArray.Add "stalled"
    eventsArray.Add "storage"
    eventsArray.Add "submit"
    eventsArray.Add "suspend"
    eventsArray.Add "timeupdate"
    eventsArray.Add "toggle"
    eventsArray.Add "touchcancel"
    eventsArray.Add "touchend"
    eventsArray.Add "touchmove"
    eventsArray.Add "touchstart"
    eventsArray.Add "transitionend"
    eventsArray.Add "unload"
    eventsArray.Add "volumechange"
    eventsArray.Add "waiting"
    eventsArray.Add "wheel"

    'set un and pw obj
    Set user = IE.Document.all.user
    Set pass = IE.Document.all.pass

    'enter un and pw
    user.Value = "[email protected]"
    pass.Value = "test123"

    'for each element
    For Each ele In Array(user, pass)
        'fire all poss events
        For Each fEvent In eventsArray
            On Error Resume Next
            ele.FireEvent ("on" & fEvent)
            ele.FireEvent (fEvent)
            On Error GoTo 0
        Next
    Next

    'exec all scripts availible in document
    For Each scr In IE.Document.Scripts
        On Error Resume Next
        Call IE.Document.parentWindow.execScript(scr.src, "JavaScript")
        On Error GoTo 0
    Next

    'sign in
    IE.Document.getElementById("loginLink").Click

发生的事情是点击登录后返回“你丢失了电子邮件地址blahblah”，两个值都消失了。如果我在提交之前手动修改其中一个字段，则另一个值将消失。

我已经尝试了一些随机的事情，比如添加事件监听器，点击，聚焦以及什么不是，甚至在输入用户名和密码的每个字符后都尝试做所有这些事情。我承认我只是盲目地尝试了所有这些事情，希望能有所作为，显然没有成功，我不知道该怎么做。任何帮助将不胜感激！

/ edit：我通过使用sendkeys（每个字段中的空格+退格）获得了所需的结果，但我不希望这样做。当然有更好的方法吗？

Answer 1

我使用selenium basic vba（安装并确保最新的chromedriver在selenium文件夹中）和vbe> tools> references>添加selenium类型库引用。它更清洁。

Option Explicit
Public Sub Login()
    Dim d As WebDriver
    Set d = New ChromeDriver

    With d
        .Start "Chrome"
        .get "https://uk.webuy.com/"

        .FindElementByCss("#signIn").Click
        .FindElementByCss("#user").SendKeys "[email protected]"
        .FindElementByCss("#pass").SendKeys "password"
        .FindElementByCss("#loginLink").Click

        Stop

        .Quit
    End With
End Sub

Answer 2

你尝试过这样的事情：

Sub cexLogIn()
Dim req As New WinHttpRequest
Dim reqBody As String
Dim reqURL As String
Dim respHeaders As String
Dim resp As String
reqURL = "https://wss2.cex.uk.webuy.io/v3/members/login"
reqBody = "{""password"":""PASSWORD"",""email"":""[email protected]""}" 'use your credentials
With req
    .Open "POST", reqURL, False
    .setRequestHeader "Host", "wss2.cex.uk.webuy.io"
    .setRequestHeader "Accept", "application/json, text/plain, */*"
    .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
    .setRequestHeader "Accept-Encoding", "gzip, deflate, br"
    .setRequestHeader "Referer", "https://uk.webuy.com/"
    .setRequestHeader "Content-Type", "application/json;charset=UTF-8"

    .send reqBody
    resp = .responseText
    respHeaders = .getAllResponseHeaders
End With
Debug.Print respHeaders
Debug.Print resp
End Sub

更改大写以匹配您的凭据。

这应该通常会让您登录，并且您的会话cookie应该在响应标头中返回给您。此cookie可能会附加到您要对网站提出的任何进一步请求中。

我没有尝试过，因为我不想注册，但你可以尝试一下，看看它是怎么回事。

参考文献：Microsoft WinHTTP Services, version 5.1