Sub setCookies(header As String)
Dim cookie As String
Dim Name As String
Dim Value As String
cookie = Mid(header, InStr(header, ":") + 1, Len(header) - InStr(header, ":") + 1)
'They will be delimited by ";"
If ((InStr(cookie, ";") <> 0) < Len(cookie)) Then 'we found a list of cookies
Do Until (InStr(cookie, ";") = 0)
If (InStr(cookie, "=") > 0) Then 'name=value
Name$ = Trim(Mid(cookie, 1, InStr(cookie, "=") - 1))
Else
Name$ = cookie
End If
Value$ = Trim(Mid(cookie, 1, (InStr(cookie, ";") - 1)))
On Error Resume Next
If Not (Value$ = "FORMCRED=") Then
colCookies.Add Value$, Name$
'Lets update cookies we already have...
If Err.Number = 457 Then
colCookies.Remove Name$
colCookies.Add Value$, Name$
Err.Clear
End If
End If
cookie = Mid(cookie, InStr(cookie, ";") + 1, Len(cookie) - InStr(cookie, ";") + 1)
Loop
End If
'Process only cookie in list or last cookie from list
If (InStr(cookie, "=") > 0) Then 'name=value
Name$ = Trim(Mid(cookie, 1, InStr(cookie, "=") - 1))
Else
Name$ = cookie
End If
Value$ = Trim(Mid(cookie, 1, Len(cookie)))
On Error Resume Next
colCookies.Add Value$, Name$
If Err.Number = 457 Then
colCookies.Remove Name$
colCookies.Add Value$, Name$
Err.Clear
End If
End Sub
Welcome to VBA Tips & Tricks. All VBA related information will be posted on this blog. Of late, VBA has been disregarded by many software professionals for .Net, c# and other technologies. This blog will also post articles related to them too Happy reading
Friday, January 22, 2010
Get Cookies
Function getCookies()
For Each Item In colCookies
If getCookies = "" Then
getCookies = Item
Else
getCookies = getCookies & ";" & Item
End If
Next Item
End Function
For Each Item In colCookies
If getCookies = "" Then
getCookies = Item
Else
getCookies = getCookies & ";" & Item
End If
Next Item
End Function
Reset Cookies in VBA
Function resetCookies()
While colCookies.count > 0
colCookies.Remove 1
Wend
End Function
While colCookies.count > 0
colCookies.Remove 1
Wend
End Function
Reset Cookies in VBA
Function resetCookies()
While colCookies.count > 0
colCookies.Remove 1
Wend
End Function
While colCookies.count > 0
colCookies.Remove 1
Wend
End Function
URL Encode in VBA
Function UrlEncode(strString) 'As String
Dim strUrlEncode
Dim lngPos
For lngPos = 1 To Len(strString)
strUrlEncode = strUrlEncode & "%" & Right("0" & Hex(Asc(Mid(strString, lngPos, 1))), 2)
Next
UrlEncode = strUrlEncode
End Function
Dim strUrlEncode
Dim lngPos
For lngPos = 1 To Len(strString)
strUrlEncode = strUrlEncode & "%" & Right("0" & Hex(Asc(Mid(strString, lngPos, 1))), 2)
Next
UrlEncode = strUrlEncode
End Function
Subscribe to:
Posts (Atom)