Hallo zusammen,

hier eine Möglichkeit mit je einer Subroutine zum ver- und entschlüsseln:

Option Explicit

Public Sub verschlüsseln()
    Dim strEingabe As String, strPW As String
    strEingabe = InputBox("Zu verschlüsselnder Text:", "Texteingabe")
    
    If strEingabe = vbNullString Then
        Exit Sub
    End If
    
    strPW = InputBox("Passwort:", "Passworteingabe")
    
    If strPW = vbNullString Then
        Exit Sub
    End If
    
    MsgBox "Der verschlüsselte Text lautet: " & vbCrLf & vbCrLf & _
        Crypt(strEingabe, strPW, True), vbInformation
End Sub

Public Sub entschlüsseln()
    Dim strEingabe As String, strPW As String
    strEingabe = InputBox("Zu entschlüsselnder Text:", "Texteingabe")
    
    If strEingabe = vbNullString Then
        Exit Sub
    End If
    
    strPW = InputBox("Passwort:", "Passworteingabe")
    
    If strPW = vbNullString Then
        Exit Sub
    End If
    
    MsgBox "Der entschlüsselte Text lautet: " & vbCrLf & vbCrLf & _
        Crypt(strEingabe, strPW, False), vbInformation
End Sub

Private Function Crypt(Inp As String, Key As String, Mode As Boolean) As String
    Dim z As String
    Dim i As Integer, Position As Integer
    Dim cptZahl As Long, orgZahl As Long
    Dim keyZahl As Long, cptString As String
    
    For i = 1 To Len(Inp)
            Position = Position + 1
            If Position > Len(Key) Then Position = 1
            keyZahl = Asc(Mid(Key, Position, 1))
            
            If Mode Then
            
                'Verschlüsseln
                orgZahl = Asc(Mid(Inp, i, 1))
                cptZahl = orgZahl Xor keyZahl
                cptString = Hex(cptZahl)
                If Len(cptString) < 2 Then cptString = "0" & cptString
                z = z & cptString
            
            Else
            
                'Entschlüsseln
                If i > Len(Inp) \ 2 Then Exit For
                cptZahl = CByte("&H" & Mid$(Inp, i * 2 - 1, 2))
                orgZahl = cptZahl Xor keyZahl
                z = z & Chr$(orgZahl)
            
            End If
        Next i
     
        Crypt = z
End Function

Gruß