如何抑制cookie请求

本文介绍了如何抑制cookie请求的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 我在Excel 2013中使用vba来删除雅虎选项合同中的数据，而在获取数据的同时，我也收到多个请求接受cookie（见下面的对话框）。I am using vba inside of Excel 2013 to scrape data off of Yahoo Option Contract and while I do get the data, I also get multiple requests to accept a cookie (see dialog below).我尝试接受这一点，看看它是否会阻止更多的弹出窗口，但没有这样的运气。如何禁止对话框？I tried accepting this to see if it would prevent further popups but no such luck. How can I suppress the dialog?除此之外，我很确定有一个api的yahoo_option_contract可以提供一些免费的xml，但我不能让它上班任何人都可以验证是否有效，并提供一个解释如何使用它的链接？As an aside, I'm pretty sure there is an api for yahoo_option_contract that would serve up some cookie free xml but I couldn't get it to work. Can anyone verify that is does work and provide a link that explains how to use it?干杯 更多信息 以下是示例链接到雅虎的网站。同样的，我发现我的代码大部分都是在以前的SO帖子 Here is a sample link to yahoo's site. It also happens that I show most of my code and scrape strategy at the bottom of a previous SO post 更新 Set http = New MSXML2.XMLHTTP60With http .Open "GET", aUrl, False .send Do Until .readyState = 4 DoEvents LoopEnd WithSelect Case http.Status Case Is = 200 Set GetHttp = http Case Else err.Raise Number:=ERR_WEB_CONNECTION, _ Description:="Bad Response " & http.Status & mStrings.Bracket(http.statusText)End Select 推荐答案尝试以下VBA代码通过XHR检索页面的HTML内容，并使用RegEx解析并输出到工作表：Try VBA code below to retrieve HTML content of the page via XHR, parse it with RegEx and output to worksheet:Option ExplicitSub Scrape_Yahoo_Option_Contract() Dim sUrl As String Dim aHeaders Dim sResp As String Dim sContent Dim oTables As Object Dim oRows As Object Dim aData() Dim i As Long ' Get data sUrl = "https://finance.yahoo.com/quote/AAPL" aHeaders = Array( _ Array("user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/57.0.2987.133 Safari/537.36") _ ) XmlHttpRequest "GET", sUrl, aHeaders, "", "", sResp ' Parse tables ParseToDict "(<table class=""[^""]*?W\(100%\)[^>]*>)([\s\S]*?)</table>", sResp, oTables ' Parse rows For Each sContent In oTables.Items ParseToDict "<tr><td>(.*?)</td><td>(.*?)</td></tr>", HtmlSimplify(sContent), oRows Next ' Populate 2d array ReDim aData(1 To oRows.Count, 1 To 2) i = 1 For Each sContent In oRows aData(i, 1) = GetInnerText(sContent) aData(i, 2) = GetInnerText(oRows(sContent)) i = i + 1 Next ' Output array to worksheet 1 With ThisWorkbook.Sheets(1) .Cells.Delete Output2DArray .Cells(1, 1), aData .Cells.EntireColumn.AutoFit End WithEnd SubSub Output2DArray(oDstRng As Range, aCells As Variant) With oDstRng .Parent.Select With .Resize( _ UBound(aCells, 1) - LBound(aCells, 1) + 1, _ UBound(aCells, 2) - LBound(aCells, 2) + 1) .NumberFormat = "@" .Value = aCells End With End WithEnd SubSub XmlHttpRequest(sMethod As String, sUrl As String, arrSetHeaders, sFormData, sRespHeaders As String, sContent As String) Dim arrHeader 'With CreateObject("Msxml2.ServerXMLHTTP.3.0") ' .SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS With CreateObject("Msxml2.XMLHTTP") .Open sMethod, sUrl, False If IsArray(arrSetHeaders) Then For Each arrHeader In arrSetHeaders .SetRequestHeader arrHeader(0), arrHeader(1) Next End If .Send sFormData sRespHeaders = .GetAllResponseHeaders sContent = .ResponseText End WithEnd SubFunction HtmlSimplify(ByVal sCont) With CreateObject("VBScript.RegExp") .Global = True .MultiLine = True .IgnoreCase = True .Pattern = "(<[\w\/^<]*)[\s\S]*?>" sCont = .Replace(sCont, "$1>") .Pattern = "(?:<span>|</span>)" sCont = .Replace(sCont, "") .Pattern = "(?:<small>|</small>)" sCont = .Replace(sCont, "") .Pattern = "&nbsp;" sCont = .Replace(sCont, " ") .Pattern = "[\f\n\r\t\v]" sCont = .Replace(sCont, "") .Pattern = " +" sCont = .Replace(sCont, " ") .Pattern = "> <" sCont = .Replace(sCont, "><") End With HtmlSimplify = sContEnd FunctionSub ParseToDict(sPattern As String, sResponse As String, oDict As Object) Dim oMatch If oDict Is Nothing Then Set oDict = CreateObject("Scripting.Dictionary") With CreateObject("VBScript.RegExp") .Global = True .MultiLine = True .IgnoreCase = True .Pattern = sPattern For Each oMatch In .Execute(sResponse) If Trim(oMatch.SubMatches(0)) <> "" Then oDict(oMatch.SubMatches(0)) = oMatch.SubMatches(1) Next End WithEnd SubFunction GetInnerText(ByVal sHtml As String) As String Static oHtmlfile As Object If oHtmlfile Is Nothing Then ' init Set oHtmlfile = CreateObject("htmlfile") oHtmlfile.Open oHtmlfile.Write "<body></body>" End If ' Convert On Error Resume Next oHtmlfile.body.innerHTML = sHtml GetInnerText = oHtmlfile.body.innerTextEnd Function 这篇关于如何抑制cookie请求的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！