Friday, January 22, 2010

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

Get Cookies

Function getCookies()

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

Reset Cookies in VBA

Function resetCookies()

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