在WinHttp和VBA QueryTable之间传递会话

如何解决在WinHttp和VBA QueryTable之间传递会话

我有使用WinHttp登录的VBA代码。它重定向并需要会话密钥和cookie进行身份验证，因此我无法使用QueryTables进行身份验证。 我也有使用QueryTables从同一服务中提取数据的旧代码。

是否有可能使用在WinHttp中创建的同一会话来使用QueryTables提取数据？目前QueryTables尚未通过身份验证，由于会话未共享，我无法提取数据。

我知道可以在使用WinHttp进行身份验证之后构建解析器，但是使用QueryTables它将更加整洁，并且可以重用旧代码。

下面的代码：

Sub Log()

UrlToPostTo = "https://www.test.com"
    Set http = New WinHttp.WinHttpRequest
    http.Open "GET",UrlToPostTo,False
    http.Option(WinHttpRequestOption_EnableRedirects) = True
    http.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
    http.SetRequestHeader "Connection","keep-alive"
    http.Send
    If http.Status = "200" Then
        ' parse redirect url
        response = CStr(http.ResponseText)
        searchaction = InStr(1,response,"action",0) + 8
        searchmethod = InStr(1,"method",0) - 2
        response = Mid(response,searchaction,searchmethod - searchaction)
        response = Replace(response,"amp;","")
        UrlRedirectedTo = response
        'create POST request
        loginData = "username=user&password=pass"
        http.Open "POST",UrlRedirectedTo,False
        http.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
        http.SetRequestHeader "Connection","keep-alive"
        http.Send loginData
        ' logged in to www.test.com
    End If



With Sheets("Log").QueryTables.Add(Connection:="https://www.test.com/service1/table1",Destination:=Sheets("Log").Range("$A$1"))
        .Name = "Log"
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xloverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebdisableDateRecognition = False
        .WebdisableRedirections = False
        .Refresh BackgroundQuery:=False
        
        
End With
Application.displayAlerts = False
Application.displayAlerts = True
    
End Sub