在宏vba循环中添加附件

Question

我想向此编码添加自定义附件。我设法通过循环创建文件，但是在从Lotus Notes发送电子邮件时无法附加相同的宏

Sub SendMail()

    Dim Notes, db, WorkSpace
    Dim UIdoc, UserName, MailDbName
    Dim strAttachment As String
    Dim emp As String
    Dim empfile As String
    Dim AttachME As Object 'The attachment richtextfile object
    Dim EmbedObj As Object 'The embedded object (Attachment)


    Set Notes = CreateObject("Notes.NotesSession")
    emp = Sheet4.Cells(6, 3)
    empfile = "" + emp + ".xlsx"


    UserName = Notes.UserName
    MailDbName = Left(UserName, 1) & Right(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

    Set db = Notes.GETDATABASE(vbNullString, MailDbName)

    Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
    Call WorkSpace.ComposeDocument(, , "Memo")
    toid = Sheet4.Cells(6, 3)
    ccid = Sheet4.Cells(12, 3)
    strAttachment = "E:\CTG MIS\Score Card\" + empfile
    Set UIdoc = WorkSpace.CurrentDocument
    Call UIdoc.FieldSetText("EnterSendTo", toid) 'Recipient
    Call UIdoc.FieldSetText("EnterCopyTo", ccid) 'Recipient
    subj = Sheet4.Cells(1, 3)
    Call UIdoc.FieldSetText("Subject", subj)

    ActiveWorkbook.Sheets("Template").Activate
    Sheets("Template").Range("B2:S38").Select
    Selection.CopyPicture xlScreen, xlBitmap
    Call UIdoc.GotoField("Body")
    Call UIdoc.SelectAll
    Call UIdoc.Paste
    Application.CutCopyMode = False


    Call UIdoc.SEND(False)
    UIdoc.Close
    Set UIdoc = Nothing: Set WorkSpace = Nothing
    Set db = Nothing: Set Notes = Nothing


End Sub