基于Excel VBA实现供应商延迟交付管控自动邮件发送工具的技术求助

Let’s break down what’s missing in your current code and build a working solution step by step. Your goal is to automate sending filtered Excel workbooks to suppliers based on column AC (supplier) and AE (delay duration), then clean up temporary files—here’s how to make that happen:

Key Gaps in Your Original Code #

• No logic to group data by unique suppliers (column AC) or iterate through each supplier individually
• No implementation of filtering by delay duration (column AE)
• Hardcoded email details instead of dynamic values tied to each supplier
• Focused on embedding HTML tables in the email body rather than creating and attaching a separate workbook for each supplier

Step-by-Step Corrected Implementation #

1. Extract Unique Suppliers: Pull a distinct list of suppliers from column AC to avoid duplicate processing
2. Filter Data: For each supplier, filter rows where AC matches the supplier AND AE meets your delay criteria (adjust the condition to fit your needs)
3. Create Temporary Workbooks: Generate a new workbook for each supplier’s filtered data
4. Send Emails: Configure Outlook to send the temporary workbook as an attachment to the supplier’s email (we’ll assume column AD holds supplier emails—adjust this to match your sheet structure)
5. Clean Up: Close and delete all temporary workbooks after sending, leaving only your master workbook intact

Corrected VBA Code #

Sub SendSupplierDelayReports()
    Dim wsMaster As Worksheet
    Dim uniqueSuppliers As Collection
    Dim supplier As Variant
    Dim filterRange As Range
    Dim tempWB As Workbook
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim tempFilePath As String
    Dim lastRow As Long
    Dim delayCriteria As String ' Adjust this to your specific delay condition
    
    ' Initialize settings
    Set wsMaster = ThisWorkbook.ActiveSheet ' Replace with your master sheet name if needed, e.g., Sheets("DeliveryData")
    Set uniqueSuppliers = New Collection
    delayCriteria = ">0" ' Example: only include rows with delay > 0; modify to your needs (e.g., ">7" for over 7 days)
    
    ' Turn off screen updates and events for efficiency
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    ' Get unique suppliers from column AC (AC is column 29)
    On Error Resume Next
    For lastRow = 2 To wsMaster.Cells(wsMaster.Rows.Count, "AC").End(xlUp).Row
        uniqueSuppliers.Add wsMaster.Cells(lastRow, "AC").Value, Key:=CStr(wsMaster.Cells(lastRow, "AC").Value)
    Next lastRow
    On Error GoTo 0
    
    ' Initialize Outlook
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' Process each supplier
    For Each supplier In uniqueSuppliers
        ' Clear existing filters
        wsMaster.AutoFilterMode = False
        
        ' Set filter range (adjust columns to cover your full data set)
        Set filterRange = wsMaster.Range("A1:AE" & wsMaster.Cells(wsMaster.Rows.Count, "AC").End(xlUp).Row)
        
        ' Apply filters: Match supplier (AC column) and delay criteria (AE column)
        filterRange.AutoFilter Field:=29, Criteria1:=supplier ' AC is column 29
        filterRange.AutoFilter Field:=31, Criteria1:=delayCriteria ' AE is column 31
        
        ' Check if any rows are visible (excluding header)
        If wsMaster.Range("AC2:AC" & lastRow).SpecialCells(xlCellTypeVisible).Count > 0 Then
            ' Create temporary workbook
            Set tempWB = Workbooks.Add(xlWBATWorksheet)
            
            ' Copy filtered data to temporary workbook
            wsMaster.AutoFilter.Range.Copy Destination:=tempWB.Sheets(1).Range("A1")
            
            ' Save temporary workbook to temp folder
            tempFilePath = Environ$("TEMP") & "\" & supplier & "_Delay_Report.xlsx"
            tempWB.SaveAs Filename:=tempFilePath, FileFormat:=xlOpenXMLWorkbook
            
            ' Create and send email
            Set outlookMail = outlookApp.CreateItem(0)
            With outlookMail
                .To = wsMaster.Cells(wsMaster.Range("AC:AC").Find(supplier).Row, "AD").Value ' Assume AD is supplier email column
                .Subject = "Delivery Delay Report - " & supplier
                .Body = "Hi " & supplier & "," & vbNewLine & vbNewLine & _
                        "Please find attached your delivery delay report for delayed shipments." & vbNewLine & vbNewLine & _
                        "Let us know if you have any questions." & vbNewLine & vbNewLine & _
                        "Best regards," & vbNewLine & _
                        "Your Delivery Control Team"
                .Attachments.Add tempFilePath
                .Send ' Use .Display to preview emails before sending
            End With
            
            ' Clean up temporary workbook
            tempWB.Close SaveChanges:=False
            Kill tempFilePath ' Delete the saved temp file
            
            Set outlookMail = Nothing
            Set tempWB = Nothing
        End If
    Next supplier
    
    ' Reset filters and application settings
    wsMaster.AutoFilterMode = False
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    ' Clean up objects
    Set outlookApp = Nothing
    Set uniqueSuppliers = Nothing
    Set wsMaster = Nothing
    
    MsgBox "All delivery delay reports have been sent successfully!", vbInformation
End Sub

Customization Tips #

• Adjust Column Numbers: Double-check that columns AC (29) and AE (31) match your sheet—update the Field parameters in the AutoFilter lines if your columns are shifted
• Delay Criteria: Modify the delayCriteria variable to fit your rules (e.g., "=5" for exactly 5 days, ">=3" for 3+ days)
• Supplier Email Column: Replace "AD" in the .To line with your actual email column letter
• Test First: Swap .Send with .Display in the email section to preview messages before sending them out

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