Question

我有一个简单的代码可以打开Microsoft Outlook并发送带有附件的电子邮件。我想安全地发送电子邮件。意思是，我想知道是否有任何代码等同于在Outlook中按下“安全发送”按钮。到目前为止，这是我的代码.....

    Sub EmailInvoice()
    Dim OutlookApp As Object, OutlookMessage As Object
    Dim FileName As String, EmailAddress As String

    EmailAddress = Range("ProviderEmail").Value
    FileName = "C:\Users\rblahblahblah.txt"


   Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if 
   Outlook is already open
   Err.Clear
   If OutlookApp Is Nothing Then Set OutlookApp = 
   CreateObject(class:="Outlook.Application") 'If not, open Outlook
   If Err.Number = 429 Then
   MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
   Exit Sub
   End If

   'Create a new email message
   Set OutlookMessage = OutlookApp.CreateItem(0)

   'Create Outlook email with attachment
   With OutlookMessage
    .To = EmailAddress
    .CC = ""
    .BCC = ""
    .Subject = "Invoice for Upload - " & Month
    .Body = "Please upload the attached file to the Vendor Portal."
    .Attachments.Add FileName
    .Display
    .Send
  End With
  End Sub

Answer 1

下面的代码将使用敏感度枚举发送它，但是不安全（验证邮件）。我还将我的签名（默认）添加到电子邮件中。

Sub Mail_workbook_Outlook_1（） '在Excel 2000-2013中工作 '此示例发送Activeworkbook的最后保存版本 “有关提示，请参见：http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 昏暗的OutApp作为对象昏暗OutMail作为对象暗单元格范围 Dim SigString作为字符串昏暗的签名为字符串

For Each cell In ThisWorkbook.Sheets("Email List").Range("B1:B100")
    If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
        strto = strto & cell.Value & ";"
    End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

   'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\Default.htm"

If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = ""
End If

On Error Resume Next

With OutMail
    .to = strto
    .CC = ""
    .BCC = ""
    .Subject = ("*Confidential*: Policyholder Name Here - Policy # Here - Premium Bill")
    .HTMLBody = "Attached is the most recent premium bill in Excel." & "<br><br>" & Signature
    .Attachments.Add ActiveWorkbook.FullName
    'You can add other files also like this
    '.Attachments.Add ("C:\test.txt")
    .Importance = 2 '(0=Low, 1=Normal, 2=High)
    .Sensitivity = 3 '(0=Normal, 1=Personal, 2=Private, 3=Confidential)
    .Send   'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

结束子

函数GetBoiler（ByVal sFile As String）As String 迪克·库斯莱卡（Dick Kusleika）暗淡作为对象暗淡为对象设置fso = CreateObject（“ Scripting.FileSystemObject”）设置ts = fso.GetFile（sFile）.OpenAsTextStream（1，-2） GetBoiler = ts.readall ts.Close 结束功能

通过VBA通过Outlook发送SECURE电子邮件

1 个答案: