Macro adjuntar fichero lotus

Buenos días, tengo un documento excel que coge de cada fila el asunto los destinatarios y el texto del mensaje y manda un lotus adjuntando el propio fichero excel.
Necesito que en vez de adjuntar el propio fichero adjunte otro fichero distinto, del cual pongo la ruta en la columna "D", por ejemplo D:\Alberto\Mis documentos\claves.xls
Tener en cuenta que debe mandar un correo por fila en la que la fecha indicada en la columna A sea anterior al dia de hoy
Adjunto macro que funciona perfectamente, solo hay que cambiar la parte en la que adjunta el propio fichero por la nueva parte en la que adjuntaria el fichero de la ruta que le indico en la fila en la columna D
Option Explicit 'Con envio fichero
''Aunque no lo indique, pondremos en la columna F la palabra enviado cuando''
''hayamos mandado el correo para evitar duplicidades.''
Sub enviarCorreosyFichero()
ActiveSheet.Unprotect "Envios"
On Error GoTo 0
Dim i As Long
Dim n As Integer
Dim fechaHoy As Date
fechaHoy = DateSerial(Year(Now()), Month(Now()), Day(Now()))
n = 0
For i = 1 To Sheets("envios").Cells.SpecialCells(xlCellTypeLastCell).Row
If Sheets("envios").Cells(i, 2) <> "" And Sheets("envios").Cells(i, 2) <= fechaHoy Then enviarCorreoLinea2 i, n
Next i
If n = 0 Then
' MsgBox "No se ha enviado ningún correo"
Else
'MsgBox Format$(n) & " Correos enviados"
End If
BuscaCeldaColor
ActiveSheet.Protect "Envios", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True
Ocultar_Envio
End Sub
Sub enviarCorreoLinea2(ByVal nLin As Long, ByRef n As Integer)
Dim ojbOLK As Object
Dim objMsg As Object
Dim nErrores As Integer
Dim snError As Boolean
Dim destinatarios As String
Dim aux As String
Dim i As Integer
If UCase$(Sheets("envios").Cells(nLin, 6)) = "ENVIADO" Then Exit Sub ''Ya está mandado''
Sheets("envios").Cells(nLin, 6) = "Enviado" 'Modificado inicialmente mas abajo
''Tenemos que separar las direcciones de correo que, en caso de haber más de una,''
''estarán separadas por el carácter coma "," o punto y coma ";" (da igual)''
destinatarios = Trim$(Sheets("envios").Cells(nLin, 5))
nErrores = 0
aux = ""
For i = 1 To Len(destinatarios)
If Mid$(destinatarios, i, 1) = "," Or Mid$(destinatarios, i, 1) = ";" Then
If Trim$(aux) <> "" Then ''Tenemos que mandar el correo''
''Para adjuntar fichero''
'ThisWorkbook.Save
SendNotesMail2 Sheets("envios").Cells(nLin, 3), ThisWorkbook.Path & "\" & ThisWorkbook.Name, Trim$(aux), Sheets("envios").Cells(nLin, 4), False, snError
If snError Then nErrores = nErrores + 1 Else n = n + 1
End If
aux = ""
Else
aux = aux & Mid$(destinatarios, i, 1)
End If
Next i
If Trim$(aux) <> "" Then ''Tenemos que mandar el correo''
'
ThisWorkbook.Save
SendNotesMail2 Sheets("envios").Cells(nLin, 3), ThisWorkbook.Path & "\" & ThisWorkbook.Name, Trim$(aux), Sheets("envios").Cells(nLin, 4), False, snError
If snError Then nErrores = nErrores + 1 Else n = n + 1
End If
'Sheets("envios").Cells(nLin, 6) = "Enviado"
If nErrores > 0 Then
Sheets("envios").Cells(nLin, 6).Font.ColorIndex = 3
Sheets("envios").Cells(nLin, 6).Font.Bold = True
End If
End Sub
Public Sub SendNotesMail2(ByVal Subject As String, ByVal attachment As String, ByVal recipient As String, ByVal bodytext As String, ByVal saveit As Boolean, ByRef snError As Boolean)
''Configure los objetos necesarios para la automatización en Lotus Notes''
Dim Maildb As Object ''La base de datos de correo''
Dim UserName As String ''Los usuarios actuales de toma nombre''
Dim MailDbName As String ''Los usuarios actuales de toma nombre de la base de correo electrónico''
Dim MailDoc As Object ''El documento electrónico en sí''
Dim AttachME As Object ''La inserción de objetos richtextfile''
Dim Session As Object ''Las notas de la sesión''
Dim EmbedObj As Object ''El objeto incrustado (Anexo)''
''Para que no nos de errores''
On Error Resume Next
''Start a session to notes''
Set Session = CreateObject("Notes.NotesSession")
''Obtener el nombre de usuario,períodos de sesiones y luego calcular el nombre de archivo de correo''
''Usted puede o no necesitar esta como para MailDBname con algunos sistemas que''
''puede pasar una cadena vacía''
UserName = Session.UserName
MailDbName = Left(UserName, 1) & Right(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
''Abrir la base de datos de correo electrónico en notes''
Set Maildb = Session.GETDATABASE("", MailDbName)
If Not Maildb.IsOpen = True Then Maildb.OPENMAIL
''Configure el documento por correo electrónico nuevo''
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = recipient
MailDoc.Subject = Subject
MailDoc.Body = bodytext
MailDoc.SAVEMESSAGEONSEND = saveit
''Configure el objeto incrustado y adjuntarlo''
If attachment <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("")
Set EmbedObj = AttachME.EmbedObject(1454, "", attachment, "Attachment")
'MailDoc.CreateRichTextItem ("Attachment")
End If
''Enviar el documento''
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.SEND 0, recipient
'============================================================
''Si hay algún error lo comentamos''
If Err <> 0 Then
''para que no salga error desactivamos Msgbox, sale si no esta abierto Lotus Notes''
'MsgBox "Error al enviar el correo. El mensaje del sistema es:" & _
vbCrLf & vbCrLf & Error$
snError = True
Else
If UserName = "" Then
snError = True
Else
snError = False
End If
End If
'===============================================================
''Dejamos que el sistema de sus propios errores''
On Error GoTo 0
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
Un saludo y muchas gracias