Excel VBA宏发送Outlook邮件报错及逻辑优化技术求助

Let's break down the issues in your code and fix them step by step:

1. Root Causes of the Errors #

• Mismatched If/Else & With/End With: Your first If block starts a With OutMail but never closes it with End With before jumping to Else—this is why you get the "Else without IF" error. Also, you're missing an End If for the initial If statement before the Next cell.
• Variable Name Inconsistencies: You define OutMailKPI and OutmailComment but reference OutMail in the With blocks, which will cause runtime errors.
• Flawed Loop Logic: The nested If inside the Else is redundant and will only check for missing Comments if KPI is not missing, which means you'll never send reminders for multiple missing items in the same row.

2. Corrected & Optimized Code #

Here's a revised version that fixes the syntax errors and ensures all missing items trigger the appropriate reminders (I've included two practical options):

Option 1: Separate Email for Each Missing Item #

Use this if you want to send a dedicated reminder for every single missing deliverable:

Sub SendDeliveryReminders()
    ' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim recipientName As String
    Dim recipientEmail As String
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    On Error GoTo Cleanup
    
    ' Loop through all valid email cells in column B
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        recipientEmail = cell.Value
        recipientName = Cells(cell.Row, "A").Value
        
        ' Validate email format first
        If recipientEmail Like "?*@?*.?*" Then
            ' Check for missing KPI Information
            If LCase(Cells(cell.Row, "C").Value) = "0" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = recipientEmail
                    .Subject = "Reminder: Missing KPI Information"
                    .Body = "Dear " & recipientName & "," & vbNewLine & vbNewLine & _
                            "We haven't received your KPI information yet. Please submit it at your earliest convenience."
                    '.Attachments.Add ("C:\test.txt") ' Uncomment to add attachments
                    .Send ' Replace with .Display to preview before sending
                End With
                Set OutMail = Nothing
            End If
            
            ' Check for missing Comments
            If LCase(Cells(cell.Row, "D").Value) = "0" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = recipientEmail
                    .Subject = "Reminder: Missing Comments"
                    .Body = "Dear " & recipientName & "," & vbNewLine & vbNewLine & _
                            "We haven't received your Comments yet. Please submit it at your earliest convenience."
                    '.Attachments.Add ("C:\test.txt")
                    .Send
                End With
                Set OutMail = Nothing
            End If
            
            ' Check for missing Org Chart
            If LCase(Cells(cell.Row, "E").Value) = "0" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = recipientEmail
                    .Subject = "Reminder: Missing Org Chart"
                    .Body = "Dear " & recipientName & "," & vbNewLine & vbNewLine & _
                            "We haven't received your Org Chart yet. Please submit it at your earliest convenience."
                    '.Attachments.Add ("C:\test.txt")
                    .Send
                End With
                Set OutMail = Nothing
            End If
        End If
    Next cell

Cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "Reminder emails have been sent successfully!", vbInformation
End Sub

Option 2: Single Consolidated Email for All Missing Items (More User-Friendly) #

Use this to send one email per recipient listing all their missing deliverables (less intrusive than multiple separate emails):

Sub SendConsolidatedReminders()
    ' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim recipientName As String
    Dim recipientEmail As String
    Dim missingItems As String
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    On Error GoTo Cleanup
    
    ' Loop through all valid email cells in column B
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        recipientEmail = cell.Value
        recipientName = Cells(cell.Row, "A").Value
        missingItems = ""
        
        ' Validate email format first
        If recipientEmail Like "?*@?*.?*" Then
            ' Build a list of all missing items
            If LCase(Cells(cell.Row, "C").Value) = "0" Then
                missingItems = missingItems & "- KPI Information" & vbNewLine
            End If
            If LCase(Cells(cell.Row, "D").Value) = "0" Then
                missingItems = missingItems & "- Comments" & vbNewLine
            End If
            If LCase(Cells(cell.Row, "E").Value) = "0" Then
                missingItems = missingItems & "- Org Chart" & vbNewLine
            End If
            
            ' Only send email if there are missing items
            If missingItems <> "" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = recipientEmail
                    .Subject = "Reminder: Missing Delivery Items"
                    .Body = "Dear " & recipientName & "," & vbNewLine & vbNewLine & _
                            "We haven't received the following items from you yet:" & vbNewLine & vbNewLine & _
                            missingItems & vbNewLine & _
                            "Please submit them at your earliest convenience."
                    '.Attachments.Add ("C:\test.txt")
                    .Send ' Replace with .Display to preview before sending
                End With
                Set OutMail = Nothing
            End If
        End If
    Next cell

Cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "Consolidated reminder emails have been sent successfully!", vbInformation
End Sub

3. Key Improvements #

• Syntax Fixes: All If statements have matching End If, and all With blocks are properly closed with End With.
• Complete Logic: Each deliverable is checked independently, so no missing items get overlooked.
• User Experience: The consolidated option avoids spamming recipients with multiple emails.
• Maintainability: Descriptive variable names make the code easier to read and modify later.
• Error Safety: The cleanup block ensures Outlook and Excel objects are properly released even if an error occurs.

内容的提问来源于stack exchange，提问作者Aubrey Moore