VBA创建Outlook邮件按单封最多10个附件拆分文件报错咨询

1 报错直接原因 #

你的代码出现Object doesn't support this property or method错误的核心是拼写错误：
Outlook邮件对象的附件集合正确属性名是Attachments，你的代码中误写为Attachements（在h和m之间多写了一个e）。

2 其他逻辑问题 #

原代码还存在附件分配逻辑错误，无法实现每10个文件拆分一封邮件的需求：

• 没有跳过已处理附件的逻辑，每封邮件都会重复添加最前面的10个文件
• 计数器Z的累加位置错误放在了内层遍历文件的循环里，计数规则完全错乱

3 修正后完整代码 #

Sub attach()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sFolder As String
    Dim fs As Object, f As Object, fls As Object
    Dim fileCount As Long, processedCount As Long
    Const MAX_ATTACH_PER_MAIL As Integer = 10 ' 单封邮件最大附件数，可自行调整
    
    ' 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        If .Show <> -1 Then Exit Sub ' 用户取消选择则直接退出
        sFolder = .SelectedItems(1)
    End With
    
    ' 读取文件夹下所有文件
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(sFolder)
    Set fls = f.Files
    fileCount = fls.Count
    If fileCount = 0 Then
        MsgBox "所选文件夹内无文件", vbExclamation
        Exit Sub
    End If
    
    processedCount = 0 ' 已处理的文件计数
    ' 循环创建邮件，每满10个附件新建一封
    Do While processedCount < fileCount
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        With OutMail
            .To = "abc@gmail.com"
            .CC = ""
            .Subject = "file"
            
            Dim currentAttachCount As Integer
            currentAttachCount = 0
            Dim x As Object
            ' 遍历所有文件，跳过已处理的，添加最多10个附件
            For Each x In fls
                If currentAttachCount >= MAX_ATTACH_PER_MAIL Then Exit For
                If processedCount > 0 Then
                    processedCount = processedCount - 1 ' 跳过已处理的文件
                Else
                    .Attachments.Add sFolder & "\" & x.Name
                    currentAttachCount = currentAttachCount + 1
                End If
            Next
            processedCount = processedCount + currentAttachCount ' 更新总处理计数
            .Display
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
    Loop
    Set fls = Nothing
    Set f = Nothing
    Set fs = Nothing
End Sub

4 关键修改说明 #

• 修正了Attachments的拼写错误
• 新增取消选择文件夹、空文件夹判断的异常处理逻辑
• 用processedCount全局记录已处理的文件数，避免重复添加附件
• 将单封最大附件数设为常量，方便后续调整

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