Attach workbook from Lotus Notes

I think you would have to save a copy first and then call the second macro?

Change the Path to the one you are using.

Sub TheCman81()
Dim wbk As Workbook
Dim y As String
Set wbk = ActiveWorkbook
y = wbk.Name
wbk.SaveAs "new attachment"
Workbooks.Open y
call TheCman81b
End Sub

Sub TheCman81b()
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim y As String
Dim Attachment1 As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim EmbedObj1 As Object
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
y = "new attachment"
' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)

' Select range of e-mail addresses
Recipient = "email address"
MailDoc.SendTo = Recipient
MailDoc.Subject = "Test"
MailDoc.Body = ""
MailDoc.SaveMessageOnSend = True
Attachment1 = "D:\Common\data\IBMMAIN\" & y & ".xls" ' Required File Name
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", "D:\Common\data\IBMMAIN\" & y & ".xls", "") 'Required File Name
On Error Resume Next
End If
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub

I don't know if this will work but you can try too attach a copy directly from the path. Since your active file is only a copy.

Sub TheCman81b()
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Attachment1 As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim EmbedObj1 As Object
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)

' Select range of e-mail addresses
Recipient = "email address"
MailDoc.SendTo = Recipient
MailDoc.subject = "Test"
MailDoc.Body = ""
MailDoc.SaveMessageOnSend = True
Attachment1 = "D:\Common\data\YOUR MACRO PATH AND FILE NAME.xls" ' Required File Name
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", "D:\Common\data\YOUR MACRO PATH AND FILE NAME.xls", "") 'Required File Name
On Error Resume Next
End If
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub

Glad to hear you found a solution.