Public Function EncodeString(ByVal ToEncode As String, ByVal strKey As String) _
  As String
Dim strResult As String, i As Long, cfc() As Integer
  ReDim cfc(1 To Len(strKey))
  For i = 1 To UBound(cfc)
    cfc(i) = Asc(Right(strKey, Len(strKey) - i + 1))
  Next i
  For i = 1 To Len(ToEncode)
    strResult = strResult & Chr(addToIndex(Asc(Right(ToEncode, Len(ToEncode) - _
      i + 1)), VirtPos(i, cfc)))
  Next i
  EncodeString = strResult
End Function
 
Public Function DecodeString(ByVal ToDecode As String, ByVal strKey As String) _
  As String
Dim strResult As String, i As Long, cfc() As Integer, ttc() As Integer
  On Error Resume Next
  ReDim cfc(1 To Len(strKey))
  ReDim ttc(1 To Len(ToDecode))
  For i = 1 To UBound(cfc)
    cfc(i) = Asc(Right(strKey, Len(strKey) - i + 1))
  Next i
  For i = 1 To Len(ToDecode)
    strResult = strResult & Chr(GetOfIndex(Asc(Right(ToDecode, Len(ToDecode) - _
      i + 1)), VirtPos(i, cfc)))
  Next i
  DecodeString = strResult
End Function
 
Private Function VirtPos(i As Long, a() As Integer) As Integer
  If i > UBound(a) Then
    VirtPos = VirtPos(i - UBound(a), a)
  Else
    VirtPos = a(i)
  End If
End Function
 
Private Function addToIndex(i As Integer, j As Integer) As Integer
  If i + j > 255 Then
    addToIndex = i + j - 255
  Else
    addToIndex = i + j
  End If
End Function
 
Private Function GetOfIndex(i As Integer, j As Integer) As Integer
  If i - j < 0 Then
    GetOfIndex = i - j + 255
  Else
    GetOfIndex = i - j
  End If
End Function