AW: Mails über vba verschlüsselt senden
28.09.2003 14:21:29
Reinhard
Hi andi,
z.B. mit dem Folgenden verschlüsseln, senden und Empfänger muss dann entschlüsseln:
(aus https://www.herber.de/forum/archiv/88to92/t88960.htm von Matthias)
Gruß
Reinhard
Sub Verschluesseln()
Dim i As Integer, j As Integer
Dim Zelle As String
Dim Start As Integer
Zelle = ActiveCell.Value
j = 0
For i = 1 To Len(Zelle)
If Asc(Mid(Zelle, i, 1)) <> 32 Then
Select Case Asc(Mid(Zelle, i, 1))
Case 65 To 90, 97 To 122
Select Case Asc(Mid(Zelle, i, 1)) - j
Case 65 To 90, 97 To 122
Start = Asc(Mid(Zelle, i, 1)) - j
Case 61 To 64, 93 To 96
Start = Asc(Mid(Zelle, i, 1)) + 26 - j
Case Else
Start = Asc(Mid(Zelle, i, 1)) - j
End Select
Case Else
Start = Asc(Mid(Zelle, i, 1)) - j
End Select
Else
Start = 32
End If
Mid(Zelle, i, 1) = Chr(Start)
j = j + 2
If j = 6 Then j = 0
Next
ActiveCell.Value = Zelle
End Sub
Sub Entschluesseln()
Dim i As Integer, j As Integer
Dim Zelle As String
Dim Start As Integer
Zelle = ActiveCell.Value
j = 0
For i = 1 To Len(Zelle)
If Asc(Mid(Zelle, i, 1)) <> 32 Then
Select Case j
Case 0
Start = Asc(Mid(Zelle, i, 1)) - j
Case 2, 4
Select Case Asc(Mid(Zelle, i, 1)) + j
Case 65 + j To 90, 97 + j To 122
Start = Asc(Mid(Zelle, i, 1)) + j
Case 91 To 90 + j, 123 To 122 + j
Start = Asc(Mid(Zelle, i, 1)) - 26 + j
Case Else
Start = Asc(Mid(Zelle, i, 1)) + j
End Select
End Select
Else
Start = 32
End If
Mid(Zelle, i, 1) = Chr(Start)
j = j + 2
If j = 6 Then j = 0
Next
ActiveCell.Value = Zelle
End Sub