vba從excel發送帶有發件人標志的電子郵件

Question

我有一個允許發送電子郵件的功能。 是否可以為發件人添加帶有提醒的標志？ [編輯]我不需要窗口本身，我只想為發件人設置提醒。

Function SendHTMLEmail()
Dim olApp As Object
Dim NewMail As Object
On Error GoTo err

Set olApp = CreateObject("Outlook.Application")
Set NewMail = olApp.CreateItem(0)

With NewMail
    .subject = "subject"
    .body = "body"
    .Display

    bodyFormat = "<BODY style=font-family:Calibri>" & body & "</BODY>"
    NewMail.HTMLBody = bodyFormat & NewMail.HTMLBody

End With

err:
Set olApp = Nothing
Set NewMail = Nothing
End Function

Answer 1

如果沒有用戶交互就沒有辦法，有一個通用命令來按下仍然適用於該按鈕的按鈕。

Function SendHTMLEmail()

    Dim olApp As Object
    Dim NewMail As Object
    
    On Error GoTo err
    
    Set olApp = CreateObject("Outlook.Application")
    Set NewMail = olApp.CreateItem(0)
    
    With NewMail
    
        .Subject = "subject"
        .Body = "body"
        .Display
                
        ' If the AddReminder button is available in your version of Outlook.
        .GetInspector.CommandBars.ExecuteMso ("AddReminder")
        
        ' Some previously working code, where the applicable button is available, now fails.
        '
        '  https://docs.microsoft.com/en-us/office/vba/api/Office.CommandBars.ExecuteMso
        '
        '  This method is useful in cases where there is no object model for a particular command.
        '  Works on controls that are built-in buttons, toggleButtons, and splitButtons.
        '  On failure it returns E_InvalidArg for an invalid idMso,
        '   and E_Fail for controls that are not enabled or not visible.
        
    End With

err:
    Set olApp = Nothing
    Set NewMail = Nothing
    
End Function

Answer 2

您不能在發送前查看，但在使用已發送郵件文件夾上的 ItemAdd 事件發送后獲得相同的結果：

在 ThisOutlookSession 模塊中

Private Sub sentFolderItems_ItemAdd(ByVal obj As Object)

    Dim mail As MailItem
           
    If TypeOf obj Is MailItem Then
        
        Set mail = obj
            
        With mail
        
            Debug.Print
            Debug.Print ".Subject.......: " & .Subject
            
            '  restrict mail in an appropriate manner if needed
            'If InStr(UCase(.Subject), UCase("add follow up flag and reminder")) > 0 Then
                
                ' this sets the "Follow up" flag
                '
                ' *** Add Reminder option not required ***
                '
                ' https://docs.microsoft.com/en-ca/office/vba/api/Outlook.OlMarkInterval
                .MarkAsTask olMarkNoDate
                Debug.Print ".IsMarkedAsTask: " & .IsMarkedAsTask
                
                ' if Add Reminder is available
                '.TaskStartDate = Date + 1
                'Debug.Print ".TaskStartDate.: " & .TaskStartDate
                
                ' if Add Reminder is available
                '.TaskDueDate = Date + 2
                'Debug.Print ".TaskDueDate...: " & .TaskDueDate
                
                .ReminderSet = True
                
                ' in a MarkAsTask item, if Add Reminder is available
                '  ReminderTime is displayed
                '
                ' in a .FlagRequest = "test" item
                '  or deprecated .FlagStatus = olFlagMarked item,
                '  use .FlagDueBy
                '
                '  d = days,  h=hour, n = minute not m
                .ReminderTime = DateAdd("n", 1, Now)
                
                .Save
                
                ' ** A saved ReminderTime is not sufficient to trigger a reminder
                ' **  must have the Add Reminder option in the menu
                Debug.Print ".ReminderTime..: " & .ReminderTime

            'End If
            
        End With
            
    End If
    
End Sub

去測試

Private Sub sentFolderItems_ItemAdd_test()
    sentFolderItems_ItemAdd ActiveInspector.CurrentItem
End Sub

設置sentFolderItems_ItemAdd 。

Option Explicit
Private WithEvents sentFolderItems As Items

Sub Application_Startup()
    Dim sentFolder As folder
    Set sentFolder = Session.GetDefaultFolder(olFolderSentMail)
    Set sentFolderItems = sentFolder.Items
End Sub

手動運行Application_Startup或重新啟動 Outlook。
注意：如果/當事件神秘地停止觸發時，請重新運行Application_Startup 。
如果沒有Private您可以分配給一個按鈕或從其他代碼調用以減少停機時間。

vba從excel發送帶有發件人標志的電子郵件

問題描述

2 個解決方案

解決方案1
0 2020-09-16 22:48:43

解決方案2
0 2020-09-20 00:18:20

vba從excel發送帶有發件人標志的電子郵件

問題描述

2 個解決方案

解決方案1 0 2020-09-16 22:48:43

解決方案2 0 2020-09-20 00:18:20

解決方案1
0 2020-09-16 22:48:43

解決方案2
0 2020-09-20 00:18:20