如何从excel中包含任何值（文件路径）的列中添加多个附件

我正在尝试创建一个VBA代码，该代码将能够告诉excel从包含任何值（文件路径）的特定列添加多个附件

例如，我的Excel列BD2:BD2000仅包含电子邮件附件列表，我希望Excel从单元格BD2:BD20000中选择所有值（如果它们不是空的，基本上是文件路径），并将其作为多个附件附加到我的outlook电子邮件

然而，我不能让它工作

这就是我到目前为止所做的：

Private Sub ToggleButton3_Click()

 Dim OutApp As Object
    Dim OutMail As Object

    Set emailRng = Worksheets("Workings").Range("BC2:BC2000")
    Set FilepathRng = Worksheets("Workings").Range("BD2:BD2000")


    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value

    Next

    sTo = Mid(sTo, 2)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Next

    sTo = Mid(sTo, 2)


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ComboBox17.Value
        .CC = sTo
        .BCC = ""
        .Subject = TextBox18.Value
        .Body = "Hi there"
        .Attachments.add = FilepathRng


    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub

如果有人愿意帮忙，我将不胜感激。我是VBA新手，我正在尝试为这个问题找到简单的解决方案，所以我非常感谢任何人能提供的详细且易于理解的建议/解决方案

---

谢谢大家!

此代码将附加“BC2:BC2000”范围内的所有文件路径

警告: 在一封电子邮件中添加那么多文件不是一个好方法。您的系统可能会挂起。要添加2000个文件，请相应地更改For循环中的范围

Private Sub ToggleButton3_Click()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cl As Range
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    Set emailRng = Worksheets("Workings").Range("BC2:BC2000")

    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value

    Next

    sTo = Mid(sTo, 2)

    With OutMail
        .To = ComboBox17.Value
        .CC = sTo
        .BCC = ""
        .Subject = TextBox18.Value
        .Body = "Hi there"

        For Each cl In Worksheets("Workings").Range("BD2:BD2000")
            If Len(cl.Value) > 1 Then
            .Attachments.Add cl.Value
            End If
        Next

        .Display

    End With


    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub

---

首先，需要用路径填充数组，例如：

With ThisWorkbook.Sheets("Workings")
    LastRow = .Cells(.Rows.Count, "BD").End(xlUp).Row
    ReDim myFileList(1 To LastRow - 2)
    i = 1
    For Each C In .Range("BD2:BD" & LastRow)
        myFileList(i) = C
        i = i + 1
    Next C
End With

然后，要添加附件，您需要执行以下操作：

    For i = LBound(myFileList) To UBound(myFileList)
        .Attachments.Add myFileList(i)
    Next i

---

你确定在一封邮件中添加2000个项目是个好主意吗？还有，你犯了什么错误？@Mikku当我点击按钮时，它就挂起了。什么也没发生。但是，当我移除附件时，它工作正常。我认为我的代码在告诉excel“将BD列中所有填充的单元格作为Outlook中的多个文件附件附加到BD列中”编辑时有问题。此外，我编辑了代码above@Nosferato4你在BC栏有什么节目？您想为该列中的每个单元格发送带有BD列附件的邮件吗？或者它将如何工作？@Nosferato4，请告诉我们它现在是否工作，或者您是否面临任何错误。@Mikku再次非常感谢！成功了！您的循环正在添加2000个值：P您还可以去掉

emailRng=。。。直到sTo=Mid…。

不需要使用您的代码；）嗨，达米安，谢谢你的建议。sTo适用于多个CC收件人；我在另一个关于2000值的指南中遇到了它，我理解您关于用我的路径填充数组的建议，但我不清楚的是我应该在哪里插入它？抱歉，如果我听起来有点傻：P VBA Noob here true，我正在查看

.To

，它用于

.CC

至于添加，就像Mikku的回答一样，您在这里放置了第二个循环来将文件添加到电子邮件中。

code on Error Resume Next With OutMail.To=combox17.Value.CC=sTo.BCC=“”.Subject=TextBox18.Value.Body=“Hi there”与此工作簿。工作表（“工作”）LastRow=.Cells（.Rows.Count，“BD”）.End（xlUp）。Row ReDim myFileList（1到LastRow-2）i=1与.Range中的每个C（“BD2:BD”&LastRow）myFileList（i）=C i=i+1下一个C结束与For i=LBound（myFileList）到UBound（myFileList）。附件。添加myFileList（i）下一步我

好的，我不知道如何在评论中添加空格，但我在原始VBA代码的“.Body”下添加了您的代码。现在，它没有挂起，但没有附件。这次我是否做了其他错误的事情？D: