如何加密從 Excel VBA 創建的 outlook 郵件（在 Outlook > 選項 > 加密中）

Question

我正在使用以下代碼使用電子表格中的動態變量生成大量電子郵件。 本質上，這會在 outlook 中創建電子郵件，更改名稱 (C1)、電子郵件、主題、用戶名 (c5) 和密碼 (c6) 的變量。

我需要找到一種方法來加密這些用代碼生成的郵件，因為這是敏感信息。 請問有人知道怎么做嗎？

Sub send_mass_email()

    Dim i As Integer
    Dim name, email, body, subject, copy, place, business As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    
    body = ActiveSheet.TextBoxes("TextBox 1").Text
    
    
    i = 2
    'Loop down name column starting at row 2 column 1
    Do While Cells(i, 1).Value <> ""
        
        name = Split(Cells(i, 1).Value, " ")(0)
        email = Cells(i, 2).Value
        subject = Cells(i, 3).Value
        copy = Cells(i, 4).Value
        business = Cells(i, 5).Value
        place = Cells(i, 6).Value
        
        body = Replace(body, "C1", name)
        body = Replace(body, "C5", business)
        body = Replace(body, "C6", place)
    
        
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
             .to = email
             .cc = copy
             .subject = subject
             .body = body
             '.Attachments.Add ("") 'You can add files here
             .display
             '.Send
        End With
    
        body = ActiveSheet.TextBoxes("TextBox 1").Text 'reset body text
        
        i = i + 1
    Loop
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    MsgBox "Email(s) Sent!"
    
End Sub

我嘗試從另一個堆棧溢出線程添加代碼，但我認為它是為 outlook vba 設計的，所以當我運行它時它給出了類型不匹配，因為我在原始代碼中將 Outmail 定義為對象

Public Sub Mailitem_SignEncr(OutMail As Outlook.MailItem, doSign As Long, doEncr As Long)

    Const PR_SECURITY_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x6E010003"
    Const SECFLAG_ENCRYPTED As Long = &H1
    Const SECFLAG_SIGNED As Long = &H2

    Dim SecFlags As Long

    ' Get current flags value
    SecFlags = OutMail.PropertyAccessor.GetProperty(PR_SECURITY_FLAGS)

    ' Turn flags on/off

    If doSign > 0 Then
        ' ON
        SecFlags = SecFlags Or SECFLAG_SIGNED
    ElseIf doSign < 0 Then
        ' OFF
        SecFlags = SecFlags And (Not SECFLAG_SIGNED)
    Else
        ' leave this flag as it is
    End If

    If doEncr > 0 Then
        SecFlags = SecFlags Or SECFLAG_ENCRYPTED
    ElseIf doEncr < 0 Then
        SecFlags = SecFlags And (Not SECFLAG_ENCRYPTED)
    End If

    ' and set the modified flags
    OutMail.PropertyAccessor.SetProperty PR_SECURITY_FLAGS, SecFlags

End Sub

Answer 1

設置對 Microsoft Outlook XX.X 對象庫的引用。