Excel VBA：列表框筛选生成邮件附件及数组赋值错误排查

Error Root Causes #

• Mismatched variable types: You declared filterNLOB as a Variant array (Dim filterNLOB() As Variant), but tried to assign a Collection object with Set. Arrays don't use Set for assignment, and your SelectedItems function mixes array declaration with Collection methods.
• Invalid array usage: You declared col as a Variant array but tried to call col.Add—this method only exists for Collection objects, not arrays.

Fixed SelectedItems Function #

Use a Collection to collect selected items, then convert it to an array for easier filtering:

Function SelectedItems(lb As MSForms.ListBox) As Variant
    Dim col As New Collection
    Dim i As Long
    For i = 0 To lb.ListCount - 1
        If lb.Selected(i) Then
            col.Add lb.List(i)
        End If
    Next i
    ' Convert Collection to array
    Dim arr() As Variant
    ReDim arr(1 To col.Count)
    For i = 1 To col.Count
        arr(i) = col(i)
    Next i
    SelectedItems = arr
End Function

Fixed Click Event Code #

Declare filter variables as Variant (not arrays) since the function returns an array, and remove Set:

Private Sub cmdB_PrepareFile_Click()
    Dim filterNLOB As Variant
    Dim filterNLIB As Variant
    Dim filterHUOB As Variant

    filterNLOB = SelectedItems(Me.lstB_NLOB)
    filterNLIB = SelectedItems(Me.lstB_NLIB)
    filterHUOB = SelectedItems(Me.lstB_HUOB)

    ' Proceed with filtering and file copy logic below
End Sub

Step-by-Step Filtering & File Copy Logic #

1. Create a New Workbook #

Dim newWB As Workbook
Set newWB = Workbooks.Add

2. Copy Source Sheets to New Workbook #

Assume your source workbook is ThisWorkbook (the one with the UserForm):

ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Copy Before:=newWB.Sheets(1)
' Delete default blank sheet
Application.DisplayAlerts = False
newWB.Sheets("Sheet1").Delete ' Adjust name if needed
Application.DisplayAlerts = True

3. Apply Filters to Each Sheet #

For each sheet, apply the filter if selections exist; clear content if no selections:

' Example for NLOB sheet (adjust sheet name/column index)
With newWB.Sheets("NLOB_Sheet")
    If UBound(filterNLOB) >= 1 Then ' Check for selected items
        .Range("A1").AutoFilter Field:=1, Criteria1:=filterNLOB, Operator:=xlFilterValues
    Else
        .Cells.ClearContents ' Leave sheet empty
    End If
End With

' Repeat for NLIB sheet
With newWB.Sheets("NLIB_Sheet")
    If UBound(filterNLIB) >= 1 Then
        .Range("A1").AutoFilter Field:=1, Criteria1:=filterNLIB, Operator:=xlFilterValues
    Else
        .Cells.ClearContents
    End If
End With

' Repeat for HUOB sheet
With newWB.Sheets("HUOB_Sheet")
    If UBound(filterHUOB) >= 1 Then
        .Range("A1").AutoFilter Field:=1, Criteria1:=filterHUOB, Operator:=xlFilterValues
    Else
        .Cells.ClearContents
    End If
End With

4. Save the Filtered Workbook #

Dim savePath As String
savePath = Environ("USERPROFILE") & "\Desktop\Filtered_Report.xlsx" ' Adjust path
newWB.SaveAs savePath
newWB.Close SaveChanges:=False

5. Generate Outlook Email with Attachment #

Dim olApp As Object
Dim olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)

With olMail
    .To = "" ' Add recipient email
    .Subject = "Filtered Report"
    .Body = "Please find the filtered report attached."
    .Attachments.Add savePath
    .Display ' Show email without sending
End With

Set olMail = Nothing
Set olApp = Nothing

Notes #

• Replace sheet names, column indices, and save path with your actual values.
• Ensure Outlook is installed if using the email functionality.
• The code handles empty selections by clearing the corresponding sheet's content.

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