如何在 VBA 中设置和获取 JSESSIONID cookie？
How to set and get JSESSIONID cookie in VBA?
我正在 Excel 2010 年为 Tomcat 8.5.5 上托管的 Java REST Web 服务使用 MSXML2.XMLHTTP60 编写一个 VBA Web 服务客户端。
在 VBA 中，我想从响应中获取字符串 JSESSIONID=E4E7666024C56427645D65BEB49ADC11 并在后续请求中设置它。
（如果 Excel 崩溃，似乎这个 cookie 丢失了，用户必须再次进行身份验证。我想为用户设置最后存储的 session ID，所以如果 session在服务器上仍然有效，他们不必在 Excel 客户端中 re-authenticate。）
我看到一些在线资源，根据这些资源，下面将提取 JSESSIONID cookie，但最后一行总是打印空：
Dim httpObj As New MSXML2.XMLHTTP60
With httpObj
.Open "POST", URL, False
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
.SetRequestHeader "Connection", "keep-alive"
.Send
End With
Debug.Print "Response header Cookie: " & httpObj.GetResponseHeader("Cookie") 'This should pull the JSESSIONID cookie but is empty
当我打印 httpObj.GetAllResponseHeaders 时，我没有看到任何包含 JSESSIONID 的 headers。
在相同的资源中，下面应该设置所需的 cookie，但它没有（我在服务器上打印出传入请求的 headers 并看到我的尝试没有覆盖 JSESSIONID值）。
httpObj.SetRequestHeader "Cookie", "JSESSIONID=blahblah"
我可能遗漏了 JSESSIONED 的传输机制，以及 VBA 如何以及何时提取和设置它。
尝试使用 MSXML2.ServerXMLHTTP 来控制 cookie。下面的代码显示了如何检索和解析 cookie，并使用该 cookie 发出请求：
Option Explicit
Sub Test_ehawaii_gov()
Dim sUrl, sRespHeaders, sRespText, aSetHeaders, aList
' example for https://energy.ehawaii.gov/epd/public/energy-projects-map.html
' get cookies
sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-map.html"
XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders
' get projects list
sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-list.json?sEcho=2&iColumns=5&sColumns=&iDisplayStart=1&iDisplayLength=0&mDataProp_0=0&mDataProp_1=1&mDataProp_2=2&mDataProp_3=3&mDataProp_4=4&sSearch=&bRegex=false&sSearch_0=&bRegex_0=false&bSearchable_0=true&sSearch_1=&bRegex_1=false&bSearchable_1=true&sSearch_2=&bRegex_2=false&bSearchable_2=true&sSearch_3=&bRegex_3=false&bSearchable_3=true&sSearch_4=&bRegex_4=false&bSearchable_4=true&iSortCol_0=0&sSortDir_0=asc&iSortingCols=1&bSortable_0=true&bSortable_1=true&bSortable_2=true&bSortable_3=true&bSortable_4=true"
XmlHttpRequest "GET", sUrl, aSetHeaders, "", "", sRespText
' parse project names
ParseResponse "\[""([\s\S]*?)""", sRespText, aList
Debug.Print Join(aList, vbCrLf)
End Sub
Sub XmlHttpRequest(sMethod, sUrl, aSetHeaders, sPayload, sRespHeaders, sRespText)
Dim aHeader
With CreateObject("MSXML2.ServerXMLHTTP")
.SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
.Open sMethod, sUrl, False
For Each aHeader In aSetHeaders
.SetRequestHeader aHeader(0), aHeader(1)
Next
.Send (sPayload)
sRespHeaders = .GetAllResponseHeaders
sRespText = .ResponseText
End With
End Sub
Sub ParseResponse(sPattern, sResponse, aData)
Dim oMatch, aTmp, sSubMatch
aData = Array()
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = sPattern
For Each oMatch In .Execute(sResponse)
If oMatch.SubMatches.Count = 1 Then
PushItem aData, oMatch.SubMatches(0)
Else
aTmp = Array()
For Each sSubMatch In oMatch.SubMatches
PushItem aTmp, sSubMatch
Next
PushItem aData, aTmp
End If
Next
End With
End Sub
Sub PushItem(aList, vItem)
ReDim Preserve aList(UBound(aList) + 1)
aList(UBound(aList)) = vItem
End Sub
在Localswindow断点处可以看到cookie解析的结果，第一个元素包含嵌套数组，代表JSESSIONID：
通常上面的例子是从 http://energy.ehawaii.gov/epd/public/energy-projects-list.html (question 中抓取项目名称):
另一个例子是 https://netforum.avectra.com/eweb/ ()。只需添加以下子项：
Sub Test_avectra_com()
Dim sUrl, sRespHeaders, sRespText, aSetHeaders
' example for https://netforum.avectra.com/eweb/
sUrl = "https://netforum.avectra.com/eweb/DynamicPage.aspx?Site=NEFAR&WebCode=IndResult&FromSearchControl=Yes"
XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders
End Sub
您还可以在 Locals window 中看到 cookie，不是 JSESSIONID，而是显示方法的其他人：
请注意这是一种简化的方法，它会解析所有 cookie，而不考虑路径、域、Secure 或 HttpOnly 选项。
虽然 omegastripes 发布了一个很好的解决方案，但我想分享我最终使用的解决方案。
我原来使用的MSXML2.XMLHTTP60对象不支持cookies。所以我改用 WinHttp.WinHttpRequest。
这需要添加对代码的引用：在 VBA IDE 中转到工具-->引用并确保选择 Microsoft WinHTPP.Services version xxx。
抓住饼干：
获取 cookie 并存储它的代码（假设对象 httpObj 类型为 WinHttp.WinHttpRequest）：
' Get the JESSIONID cookie
Dim strCookie As String
Dim jsessionidCookie As String
strCookie = httpObj.GetResponseHeader("Set-Cookie") ' --> "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly"
jsessionidCookie = GetJsessionIdCookie(strCookie) ' Strips to "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E"
'Store JSESSIONID cookie in the cache sheet
GetJsessionIdCookie 程序所在位置：
' Takes a string of the form "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly"
' and returns only the portion "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E"
Public Function GetJsessionIdCookie(setCookieStr As String) As String
'JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly
Dim jsessionidCookie As String
Dim words() As String
Dim word As Variant
words = Split(setCookieStr, ";")
For Each word In words
If InStr(1, word, "JSESSIONID") > 0 Then
jsessionidCookie = word
End If
Next word
GetJsessionIdCookie = jsessionidCookie
End Function
正在设置 cookie：
下面是创建 WinHttp.WinHttpRequest 对象并设置之前存储的 cookie 的方法：
Public Function GetHttpObj(httpMethod As String, uri As String, Optional async As Boolean = False, _
Optional setJessionId As Boolean = True, _
Optional contentType As String = "application/xml") As WinHttp.WinHttpRequest
Dim cacheUtils As New CCacheUtils
Dim httpObj As New WinHttp.WinHttpRequest
With httpObj
.Open httpMethod, uri, async
.SetRequestHeader "origin", "pamsXL"
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Content-type", contentType
.SetRequestHeader "cache-control", "no-cache"
End With
' --- Pull stored cookie and attach to request ---
If setJessionId Then
httpObj.SetRequestHeader "Cookie", cacheUtils.GetCachedValue(wsJsessionidAddr)
End If
Set GetHttpObj = httpObj
End Function
其中 CCacheUtils 是 class 我为存储和检索缓存值（例如 JSESSIONID cookie）而实现的。
要即时获取和设置 cookie，我最近发现了一种最简单的方法。以下是实施方式：
Sub GetRequestHeaders()
Const URL$ = "https://finance.yahoo.com/quote/AAPL?p=AAPL"
Dim Http As New ServerXMLHTTP60, Html As New HTMLDocument, strCookie$
With Http
.Open "GET", URL, False
.send
strCookie = .getAllResponseHeaders
strCookie = Split(Split(strCookie, "Cookie:")(1), ";")(0)
.Open "GET", URL, False
.setRequestHeader "Cookie", Trim(strCookie)
.send
Html.body.innerHTML = .responseText
End With
MsgBox Html.querySelector("#quote-market-notice span").innerText
End Sub
我正在 Excel 2010 年为 Tomcat 8.5.5 上托管的 Java REST Web 服务使用 MSXML2.XMLHTTP60 编写一个 VBA Web 服务客户端。
在 VBA 中，我想从响应中获取字符串 JSESSIONID=E4E7666024C56427645D65BEB49ADC11 并在后续请求中设置它。
（如果 Excel 崩溃，似乎这个 cookie 丢失了，用户必须再次进行身份验证。我想为用户设置最后存储的 session ID，所以如果 session在服务器上仍然有效，他们不必在 Excel 客户端中 re-authenticate。）
我看到一些在线资源，根据这些资源，下面将提取 JSESSIONID cookie，但最后一行总是打印空：
Dim httpObj As New MSXML2.XMLHTTP60
With httpObj
.Open "POST", URL, False
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
.SetRequestHeader "Connection", "keep-alive"
.Send
End With
Debug.Print "Response header Cookie: " & httpObj.GetResponseHeader("Cookie") 'This should pull the JSESSIONID cookie but is empty
当我打印 httpObj.GetAllResponseHeaders 时，我没有看到任何包含 JSESSIONID 的 headers。
在相同的资源中，下面应该设置所需的 cookie，但它没有（我在服务器上打印出传入请求的 headers 并看到我的尝试没有覆盖 JSESSIONID值）。
httpObj.SetRequestHeader "Cookie", "JSESSIONID=blahblah"
我可能遗漏了 JSESSIONED 的传输机制，以及 VBA 如何以及何时提取和设置它。
尝试使用 MSXML2.ServerXMLHTTP 来控制 cookie。下面的代码显示了如何检索和解析 cookie，并使用该 cookie 发出请求：
Option Explicit
Sub Test_ehawaii_gov()
Dim sUrl, sRespHeaders, sRespText, aSetHeaders, aList
' example for https://energy.ehawaii.gov/epd/public/energy-projects-map.html
' get cookies
sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-map.html"
XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders
' get projects list
sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-list.json?sEcho=2&iColumns=5&sColumns=&iDisplayStart=1&iDisplayLength=0&mDataProp_0=0&mDataProp_1=1&mDataProp_2=2&mDataProp_3=3&mDataProp_4=4&sSearch=&bRegex=false&sSearch_0=&bRegex_0=false&bSearchable_0=true&sSearch_1=&bRegex_1=false&bSearchable_1=true&sSearch_2=&bRegex_2=false&bSearchable_2=true&sSearch_3=&bRegex_3=false&bSearchable_3=true&sSearch_4=&bRegex_4=false&bSearchable_4=true&iSortCol_0=0&sSortDir_0=asc&iSortingCols=1&bSortable_0=true&bSortable_1=true&bSortable_2=true&bSortable_3=true&bSortable_4=true"
XmlHttpRequest "GET", sUrl, aSetHeaders, "", "", sRespText
' parse project names
ParseResponse "\[""([\s\S]*?)""", sRespText, aList
Debug.Print Join(aList, vbCrLf)
End Sub
Sub XmlHttpRequest(sMethod, sUrl, aSetHeaders, sPayload, sRespHeaders, sRespText)
Dim aHeader
With CreateObject("MSXML2.ServerXMLHTTP")
.SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
.Open sMethod, sUrl, False
For Each aHeader In aSetHeaders
.SetRequestHeader aHeader(0), aHeader(1)
Next
.Send (sPayload)
sRespHeaders = .GetAllResponseHeaders
sRespText = .ResponseText
End With
End Sub
Sub ParseResponse(sPattern, sResponse, aData)
Dim oMatch, aTmp, sSubMatch
aData = Array()
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = sPattern
For Each oMatch In .Execute(sResponse)
If oMatch.SubMatches.Count = 1 Then
PushItem aData, oMatch.SubMatches(0)
Else
aTmp = Array()
For Each sSubMatch In oMatch.SubMatches
PushItem aTmp, sSubMatch
Next
PushItem aData, aTmp
End If
Next
End With
End Sub
Sub PushItem(aList, vItem)
ReDim Preserve aList(UBound(aList) + 1)
aList(UBound(aList)) = vItem
End Sub
在Localswindow断点处可以看到cookie解析的结果，第一个元素包含嵌套数组，代表JSESSIONID：
通常上面的例子是从 http://energy.ehawaii.gov/epd/public/energy-projects-list.html (question 中抓取项目名称):
另一个例子是 https://netforum.avectra.com/eweb/ (
Sub Test_avectra_com()
Dim sUrl, sRespHeaders, sRespText, aSetHeaders
' example for https://netforum.avectra.com/eweb/
sUrl = "https://netforum.avectra.com/eweb/DynamicPage.aspx?Site=NEFAR&WebCode=IndResult&FromSearchControl=Yes"
XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders
End Sub
您还可以在 Locals window 中看到 cookie，不是 JSESSIONID，而是显示方法的其他人：
请注意这是一种简化的方法，它会解析所有 cookie，而不考虑路径、域、Secure 或 HttpOnly 选项。
虽然 omegastripes 发布了一个很好的解决方案，但我想分享我最终使用的解决方案。
我原来使用的MSXML2.XMLHTTP60对象不支持cookies。所以我改用 WinHttp.WinHttpRequest。
这需要添加对代码的引用：在 VBA IDE 中转到工具-->引用并确保选择 Microsoft WinHTPP.Services version xxx。
抓住饼干：
获取 cookie 并存储它的代码（假设对象 httpObj 类型为 WinHttp.WinHttpRequest）：
' Get the JESSIONID cookie
Dim strCookie As String
Dim jsessionidCookie As String
strCookie = httpObj.GetResponseHeader("Set-Cookie") ' --> "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly"
jsessionidCookie = GetJsessionIdCookie(strCookie) ' Strips to "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E"
'Store JSESSIONID cookie in the cache sheet
GetJsessionIdCookie 程序所在位置：
' Takes a string of the form "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly"
' and returns only the portion "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E"
Public Function GetJsessionIdCookie(setCookieStr As String) As String
'JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly
Dim jsessionidCookie As String
Dim words() As String
Dim word As Variant
words = Split(setCookieStr, ";")
For Each word In words
If InStr(1, word, "JSESSIONID") > 0 Then
jsessionidCookie = word
End If
Next word
GetJsessionIdCookie = jsessionidCookie
End Function
正在设置 cookie：
下面是创建 WinHttp.WinHttpRequest 对象并设置之前存储的 cookie 的方法：
Public Function GetHttpObj(httpMethod As String, uri As String, Optional async As Boolean = False, _
Optional setJessionId As Boolean = True, _
Optional contentType As String = "application/xml") As WinHttp.WinHttpRequest
Dim cacheUtils As New CCacheUtils
Dim httpObj As New WinHttp.WinHttpRequest
With httpObj
.Open httpMethod, uri, async
.SetRequestHeader "origin", "pamsXL"
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Content-type", contentType
.SetRequestHeader "cache-control", "no-cache"
End With
' --- Pull stored cookie and attach to request ---
If setJessionId Then
httpObj.SetRequestHeader "Cookie", cacheUtils.GetCachedValue(wsJsessionidAddr)
End If
Set GetHttpObj = httpObj
End Function
其中 CCacheUtils 是 class 我为存储和检索缓存值（例如 JSESSIONID cookie）而实现的。
要即时获取和设置 cookie，我最近发现了一种最简单的方法。以下是实施方式：
Sub GetRequestHeaders()
Const URL$ = "https://finance.yahoo.com/quote/AAPL?p=AAPL"
Dim Http As New ServerXMLHTTP60, Html As New HTMLDocument, strCookie$
With Http
.Open "GET", URL, False
.send
strCookie = .getAllResponseHeaders
strCookie = Split(Split(strCookie, "Cookie:")(1), ";")(0)
.Open "GET", URL, False
.setRequestHeader "Cookie", Trim(strCookie)
.send
Html.body.innerHTML = .responseText
End With
MsgBox Html.querySelector("#quote-market-notice span").innerText
End Sub