Encrypt and Decrypt Text

Here is a basic Function to Encrypt and Decrypt  any text

Public Function evtEncrypt_Decrypt(strText As String, strPWD As String) As String

    Dim byteText() As Byte

    Dim bytePWD() As Byte

    Dim intPWDPos As Integer

    Dim intPWDLen As Integer

    Dim intLoop As Integer

    byteText = strText

    bytePWD = strPWD

    intPWDLen = LenB(strPWD)

    For intLoop = 0 To LenB(strText) – 1

        intPWDPos = (intLoop Mod intPWDLen)

        byteText(intLoop) = byteText(intLoop) Xor bytePWD(intPWDPos)

    Next intLoop

    evtEncrypt_Decrypt = byteText

End Function

You can download the .xlsm from here

Sub test()

    Dim strSource As String

    Dim strtargeten As String

    Dim strtargetde As String

    Dim strpass As String

    strSource = “manoj”

    strpass = “maya”

    strtargeten = evtEncrypt_Decrypt(strSource, strpass)

    strtargetde = evtEncrypt_Decrypt(strtargeten, strpass)

End Sub

Thanks for Reading

Rajan Verma