Question

我打算在打开“我的文档”时添加多个文件。我目前有一个命令按钮，当单击时，文件对话框窗口打开。

我能够尽可能多地选择，但是当它通过电子邮件发送到地址时，它只显示2个附件，第一个是电子表格上的表单，第二个是从文件对话框窗口中选择的文件。

如何在电子邮件中添加2个以上的附件？

我尝试过使用For循环，因此可能有很多附件，但这不起作用。

请参阅下文。

Sub SbExtra_Attachment()
  'mssgbox do you have another attachment to add ?
   Response = MsgBox(prompt:="Do you have any other attachments? 'Yes'or 'No'.", Buttons:=vbYesNo)

If Response = vbYes Then

    Set fd = Application.FileDialog(msoFileDialogOpen)
        fd.AllowMultiSelect = True

        If fd.Show = -1 Then
            For i = 1 To fd.SelectedItems.Count
            StrFile = fd.SelectedItems(i)
            Next i

        End If

    Else

End If

End Sub

以上目前最多只附加2个文件。

Answer 1

根据您的需要调整：

Sub Test()

    'You already have similar lines somewhere, so adapt the code later on
    Dim strFile As String
    Dim OlApp As Object
    Dim OlMail As Object
    Dim ToRecipient As String
    Set OlApp = CreateObject("Outlook.Application")
    Set OlMail = OlApp.createitem(OlMailItem)
    OlMail.Recipients.Add "test@test.com"
    OlMail.Subject = "Test message"
    'end of code you will already have

    Dim cnt As Integer
    Dim attachments() As String

    strFile = SbExtra_Attachment(strFile, "Do you have any attachments? 'Yes'or 'No'.")

    If strFile <> "" Then

        attachments = Split(strFile, ";")

        For cnt = 0 To UBound(attachments)

            'Replace "OlMail" with the name of the Mail Object variable that you created
            With OlMail

                .attachments.Add attachments(cnt)

            End With

        Next cnt

    End If

    'Send the e-mail here
    OlMail.Send

    Set OlMail = Nothing
    Set OlApp = Nothing

End Sub

Private Function SbExtra_Attachment(fileCollection As String, FilePrompt As String) As String

    Dim Response As Integer
    Dim lngCount As Integer

    'mssgbox do you have another attachment to add ?
    Response = MsgBox(Prompt:=FilePrompt, Buttons:=vbYesNo)

    If Response = vbYes Then

        With Application.FileDialog(msoFileDialogOpen)

            .AllowMultiSelect = True
            .Show

            For lngCount = 1 To .SelectedItems.count

                If Len(fileCollection) > 0 Then fileCollection = fileCollection & ";"
                fileCollection = fileCollection & .SelectedItems(lngCount)

            Next lngCount

        End With
        fileCollection = SbExtra_Attachment(fileCollection, "Do you have any other attachments? 'Yes'or 'No'.")
    End If

    SbExtra_Attachment = fileCollection

End Function

Answer 2

感谢Davy

我目前有一个单独的代码可以在另一个模块上发送电子邮件。

If strFile = "" Then
   Else
     .Attachments.Add (strFile)
End If

strFile是公开声明的，我如何组合代码以便能够捕获文件。

由于

在FileDialog中选择多个文件以发送到电子邮件

2 个答案: