How to set and get JSESSIONID cookie in VBA?
Try to use MSXML2.ServerXMLHTTP
to get control over cookies. The code below shows how to retrieve and parse cookies, and make request using that cookies:
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
You can see the result of cookies parsing in Locals window on breakpoint, first element contain nested array, representing JSESSIONID:
Generally the above example scrapes project names from http://energy.ehawaii.gov/epd/public/energy-projects-list.html (question):
Another one example is for https://netforum.avectra.com/eweb/ (question). Just add the below Sub:
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
You can also see the cookies in Locals window, either not JSESSIONID, but others showing the method:
Note it's simplified method, it parses all cookies regardless path, domain, Secure or HttpOnly options.
While omegastripes posted a great solution, I wanted to share the solution I ended up using.
The original MSXML2.XMLHTTP60 object I used does not support cookies. So instead I used WinHttp.WinHttpRequest
.
This requires adding a reference to your code: In VBA IDE go to Tools-->References and make sure that Microsoft WinHTPP.Services version xxx
is selected.
Snagging the cookie:
Code that grabs the cookie and stores it (assuming an object httpObj
of type 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
Where the procedure GetJsessionIdCookie is:
' 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
Setting the cookie:
Here's the method that creates an WinHttp.WinHttpRequest object and sets the cookie that was previously stored:
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
Where CCacheUtils
is a class I implemented for storing and retrieving cached values such as the JSESSIONID cookie.
To get and set cookies on the fly, there is an easiest approach I've discovered lately. Here is how the implementation may be:
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