You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

寻求Outlook VBA脚本:实现邮件响应时间追踪及发送校验功能

Hey Satish, great question! Since you already have some Outlook VBA basics, this implementation should be totally achievable for you. Let's walk through how to build exactly what you're asking for—from the custom send form to validation and response time tracking.


Step 1: Build the Custom User Form

First, fire up the Outlook VBA Editor (hit Alt + F11). Right-click your project in the Project Explorer > Insert > UserForm. Then add these controls to the form:

  • Two ComboBoxes (name them cboMailType and cboStatus)
  • One CommandButton (name it cmdSend and set its Caption to "Send")
  • Labels for each ComboBox to label them "Mail Type:" and "Status:"

Next, populate the dropdowns with your desired options (tweak these to match your workflow):

Private Sub UserForm_Initialize()
    ' Fill Mail Type options
    cboMailType.AddItem "Request"
    cboMailType.AddItem "Update"
    cboMailType.AddItem "Escalation"
    cboMailType.AddItem "General"
    
    ' Fill Status options
    cboStatus.AddItem "Open"
    cboStatus.AddItem "In Progress"
    cboStatus.AddItem "Waiting on Third Party"
End Sub

Step 2: Add Validation & Send Logic to the Form

Drop this code into the UserForm's code module. It handles all your required checks (attachments, CCs) before sending, plus stores tracking data in the mail's properties:

Private Sub cmdSend_Click()
    Dim objMail As MailItem
    Set objMail = Application.ActiveInspector.CurrentItem
    
    ' 1. Make sure user selected both Mail Type and Status
    If cboMailType.Value = "" Or cboStatus.Value = "" Then
        MsgBox "Please pick both a Mail Type and Status!", vbExclamation, "Missing Info"
        Exit Sub
    End If
    
    ' 2. Check for required attachments (adjust the condition for your needs)
    Dim requiresAttachment As Boolean
    requiresAttachment = True ' Set to False if attachments are optional
    If requiresAttachment And objMail.Attachments.Count = 0 Then
        MsgBox "This mail type needs an attachment to send!", vbExclamation, "Missing Attachment"
        Exit Sub
    End If
    
    ' 3. Verify specified CC recipient is included
    Dim requiredCC As String
    requiredCC = "team@yourcompany.com" ' Replace with your mandatory CC
    Dim ccFound As Boolean
    ccFound = False
    
    For Each recip In objMail.Recipients
        If LCase(recip.Address) = LCase(requiredCC) Then
            ccFound = True
            Exit For
        End If
    Next
    
    If Not ccFound Then
        ' Prompt user to add the CC, or cancel send
        If MsgBox("Required CC " & requiredCC & " is missing. Add it now?", vbYesNo, "Missing CC") = vbYes Then
            objMail.Recipients.Add requiredCC
            objMail.Recipients.ResolveAll
        Else
            MsgBox "Mail can't be sent without the required CC.", vbCritical, "Validation Failed"
            Exit Sub
        End If
    End If
    
    ' 4. Save tracking data to the mail's custom properties
    objMail.UserProperties.Add "MailType", olText
    objMail.UserProperties("MailType").Value = cboMailType.Value
    objMail.UserProperties.Add "MailStatus", olText
    objMail.UserProperties("MailStatus").Value = cboStatus.Value
    objMail.UserProperties.Add "SentTimestamp", olDateTime
    objMail.UserProperties("SentTimestamp").Value = Now()
    
    ' 5. Finalize and send the mail
    objMail.Save
    objMail.Send
    
    ' Close the form
    Unload Me
End Sub

Step 3: Replace Default Send with Your Form

We need to hook into Outlook's ItemSend event to stop the default send action and show our form instead. Open the ThisOutlookSession module and paste this:

Private WithEvents objInspectors As Inspectors
Private WithEvents objMail As MailItem

Private Sub Application_Startup()
    Set objInspectors = Application.Inspectors
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail Then
        Set objMail = Inspector.CurrentItem
    End If
End Sub

Private Sub objMail_Send(Cancel As Boolean)
    ' Cancel the default send process
    Cancel = True
    
    ' Show our custom form
    UserForm1.Show ' Update this if you renamed your UserForm
End Sub

Step 4: Track Response Times

To monitor when recipients reply, add this code to ThisOutlookSession too. It listens for new items in your Inbox and calculates response time for tracked mails:

Private WithEvents inboxItems As Items

Private Sub Application_Startup()
    ' Initialize inbox monitoring
    Set inboxItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
    inboxItems.Sort "[ReceivedTime]", olDescending
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is MailItem Then
        Dim replyMail As MailItem
        Set replyMail = Item
        
        ' Get the original mail this is replying to
        Dim originalMail As MailItem
        On Error Resume Next ' Skip if no original mail exists
        Set originalMail = replyMail.ReplyRecipients.Item(1).Parent
        On Error GoTo 0
        
        If Not originalMail Is Nothing Then
            ' Check if original mail has our tracking timestamp
            If originalMail.UserProperties("SentTimestamp") Is Nothing Then Exit Sub
            
            ' Calculate response time in minutes
            Dim responseMins As Double
            responseMins = DateDiff("n", originalMail.UserProperties("SentTimestamp").Value, replyMail.ReceivedTime)
            
            ' Save response time to original mail
            originalMail.UserProperties.Add "ResponseTimeMins", olNumber
            originalMail.UserProperties("ResponseTimeMins").Value = responseMins
            originalMail.Save
            
            ' Optional: Notify you when a response comes in
            MsgBox "Response received! Time taken: " & responseMins & " minutes", vbInformation
        End If
    End If
End Sub

Quick Tips for Smooth Operation
  • Enable macros in Outlook (File > Options > Trust Center > Trust Center Settings > Macro Settings > Enable all macros—only do this if you trust the code!)
  • Test this in a test mail account first to avoid messing up real workflows
  • Customize the dropdown options, validation rules, and tracking fields to fit your team's needs
  • For better reporting, you can export tracking data to an Excel workbook instead of just storing it in mail properties

内容的提问来源于stack exchange,提问作者Satish

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.05.21 06:39:43