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

Tuesday, December 22, 2009

How to disable user from using short-cut keys using VBA

You can disable the keybinding using the following code

Sub VBA_DisableKey()

'This code will disables Ctrl + O FileOpen command.
' Disable Ctrl + O

FindKey(BuildKeyCode(wdKeyControl, wdKeyO)).Disable

' Rebind Ctrl + O to FileOpen

FindKey(BuildKeyCode(wdKeyControl, wdKeyO)).Rebind wdKeyCategoryCommand, "FileOpen"

End Sub

Use the rebind method to restore the bind.

How to get the free space available using VBA

Sub FreeDiskSpaceCurrent_Drive()

Dim sFreeSpace As String

sFreeSpace = System.FreeDiskSpace

sFreeSpace = Format(sFreeSpace, "0,000")

MsgBox "Free Space Available is : " & sFreeSpace

End Sub