Проблема прикрепления файла Excel к электронной почте с VBA

Question

Я пытаюсь добавить прикрепить файл к электронному письму, созданному из шаблона.Идея состоит в том, чтобы иметь возможность использовать средство выбора файлов для выбора нескольких файлов, и Excel отправляет электронное письмо нужным получателям с правильными вложениями.

Проблема заключается в том, что я не могу использовать метод ".Display", не получивошибка, и я хочу просмотреть электронное письмо перед отправкой, поэтому я не хочу использовать ".Send".

Однако по какой-либо причине, если я очищаю тело шаблона электронной почты с помощью ".Body = ''"Я могу отобразить письмо и прикрепить правильный файл.Хотелось бы сохранить тело письма в шаблоне без изменений и переписать его.

Так что мне кажется, что я не могу использовать шаблон электронной почты, если хочу сначала отобразить его перед отправкой?Кто-нибудь когда-нибудь сталкивался с этой проблемой или знает, как ее решить?

Сообщение об ошибке:

'- 2147221233 (8004010f)' Попытка выполнить операцию не удалась.Не удалось найти объект.

Кстати, большинство переменных объявлены глобально, поэтому они не видны.

Dim Agency As String
Dim xfullName As Variant
Dim Template As String
Dim mail As Outlook.mailItem
Dim myOlApp As Outlook.Application
Dim selectedFile As Variant
Dim emailBody As String
Dim emailType As String
Dim recipients As String

Sub Recall_Email()

    Dim fileName As String
    Dim inputFile As FileDialog


    Set myOlApp = CreateObject("Outlook.Application")
    Set inputFile = Application.FileDialog(msoFileDialogFilePicker)

    Template = "C:\Users\me\AppData\Roaming\Microsoft\Templates\Recall Templates\Recall Template.oft"

    With inputFile
        .AllowMultiSelect = True
        If .Show = False Then Exit Sub

    End With

    For Each selectedFile In inputFile.SelectedItems
        xfullName = selectedFile
        fileName = Mid(inputFile.SelectedItems(1), InStrRev(inputFile.SelectedItems(1), "\") + 1, Len(inputFile.SelectedItems(1)))
        Agency = Left(fileName, 3)

        CreateTemplate(Template)

    Next selectedFile


End Sub

Private Sub CreateTemplate(temp)

    Set myOlApp = CreateObject("Outlook.Application")
    Set mail = myOlApp.CreateItemFromTemplate(temp)
    Set olAtt = mail.Attachments

    With mail
        '.Body = "" -- If I use this line, everything attaches
        .Subject = Agency & " Recall File"
        .To = "email"
        .Attachments.Add xfullName
        .Display '.Send 
    End With

End Sub

Answer 1

Вот рабочий пример того, как прикреплять или вставлять файлы в outlook.

Option Explicit
Dim titleName As String
Dim firstName As String
Dim lastName As String
Dim fullName As String
Dim clientEmail As String
Dim ccEmail As String
Dim bccEmail As String
Dim emailMessage As String

Sub GenerateInfo()

    Dim WS As Worksheet
    Dim lrow As Long
    Dim cRow As Long

    Set WS = ActiveSheet

    With WS
        lrow = .Range("E" & .Rows.Count).End(xlUp).Row
        Application.ScreenUpdating = False
        For cRow = 2 To lrow
            If Not .Range("L" & cRow).value = "" Then
                titleName = .Range("D" & cRow).value
                firstName = .Range("E" & cRow).value
                lastName = .Range("F" & cRow).value
                fullName = firstName & " " & lastName
                clientEmail = .Range("L" & cRow).value

                Call SendEmail

                .Range("Y" & cRow).value = "Yes"
                .Range("Y" & cRow).Font.Color = vbGreen

            Else
                .Range("Y" & cRow).value = "No"
                .Range("Y" & cRow).Font.Color = vbRed
            End If
        Next cRow
    End With

    Application.ScreenUpdating = True

    MsgBox "Process completed!", vbInformation

End Sub
Sub SendEmail()

    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim sigString As String
    Dim Signature As String
    Dim insertPhoto As String
    Dim photoSize As String

    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)

    'Change only Mysig.htm to the name of your signature
    sigString = Environ("appdata") & _
                "\Microsoft\Signatures\Marius.htm"

    If Dir(sigString) <> "" Then
        Signature = GetBoiler(sigString)
    Else
        Signature = ""
    End If

    insertPhoto = "C:\Users\marius\Desktop\Presale.jpg" 'Picture path
    photoSize = "<img src=""cid:Presale.jpg""height=400 width=400>" 'Change image name here

    emailMessage = "<BODY style=font-size:11pt;font-family:Calibri>Dear " & titleName & " " & fullName & "," & _
                    "<p>I hope my email will find you very well." & _
                    "<p>Our <strong>sales preview</strong> starts on Thursday the 22nd until Sunday the 25th of November." & _
                    "<p>I look forward to welcoming you into the store to shop on preview.<p>" & _
                    "<p> It really is the perfect opportunity to get some fabulous pieces for the fast approaching festive season." & _
                    "<p>Please feel free to contact me and book an appointment." & _
                    "<p>I look forward to seeing you then." & _
                    "<p>" & photoSize & _
                    "<p>Kind Regards," & _
                    "<br>" & _
                    "<br><strong>Marius</strong>" & _
                    "<br>Assistant Store Manager" & _
                    "<p>"


    With outlookMail
        .To = clientEmail
        .CC = ""
        .BCC = ""
        .Subject = "PRIVATE SALE"
        .BodyFormat = 2
        .Attachments.Add insertPhoto, 1, 0
        .HTMLBody = emailMessage & Signature 'Including photo insert and signature
        '.HTMLBody = emailMessage & Signature 'Only signature
        .Importance = 2
        .ReadReceiptRequested = True
        .Display
        .Send

    End With

    Set outlookApp = Nothing
    Set outlookMail = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String

    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function