Question

我需要根据B列的单元格中的内容附加多个文件。

Sub EmailTest()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim lastRow As Long
Dim MailDest As String
Dim subj As String

lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count,"A").End(xlUp).Row 'change worksheet as needed

For i = 2 To lastRow

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    Set Attach = OutLookMailItem.Attachments

    With OutLookMailItem
        .To = Cells(i, 1).Value
        .Subject = "Test"
        .Body = "Testing an email macro, just delete me"
        On Error Resume Next
        Attach.Add [F2] & Cells(i, 2).Value & ".xlsx" 'change cell reference in brackets as needed
        .Display
        On Error GoTo 0
        '.Send
    End With

Next

End Sub

我找到了以下链接，我做了一些不成功的尝试。

Adding multiple attachments to a single email using outlook VBA

在B列中，我想输入Book2，Book3和代码，以了解这是两个不同的附件。有可能会有更多的附件，这就是为什么我想要使用附件=拆分的一些变化。

在Cell F2中，我有一个连接公式，允许用户在不了解VBA的情况下更改代码引用的文件路径。

Answer 1

你必须再使用一个循环来遍历单元格中的所有名称，为了得到这些名称的数组，我使用了Spli()方法。

'declare variable att the beginning
Dim att as Variant
'loop, also you have to enter separator here, I used ","
For Each att in Split(Cells(i, 2).Value, ",")
    Attach.Add [F2] & att & ".xlsx" 'change cell reference in brackets as needed
Next

在单元格

1 个答案: