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

使用VBA将Excel文件附加到电子邮件时出现问题

1 个答案: