Private Sub SendNotesMail()
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim EmbedObj2 As Object
Dim EmbedObj4 As Object
Dim EmbedObj5 As Object
Dim EmbedObj6 As Object
Dim EmbedObj7 As Object
Dim EmbedObj8 As Object
Dim EmbedObj9 As Object
Dim EmbedObj10 As Object
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
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
Recipient = Range("a15").Value
MailDoc.sendto = Recipient
ccRecipient = Range("b15").Value
MailDoc.CopyTo = ccRecipient
bccRecipient = Range("c15").Value
MailDoc.BlindCopyTo = bccRecipient
Subject = Range("it25")
MailDoc.Subject = Subject
BodyText = Range("b8")
MailDoc.Body = BodyText
MailDoc.SAVEMESSAGEONSEND = True Attachment1 = Range("d15")
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj1 = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment2 = Range("e15")
If Attachment2 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj2 = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment3 = Range("f15")
If Attachment3 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj3 = AttachME.EMBEDOBJECT(1454, "", Attachment3, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment4 = Range("g15")
If Attachment4 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj4 = AttachME.EMBEDOBJECT(1454, "", Attachment4, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment5 = Range("h15")
If Attachment5 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj5 = AttachME.EMBEDOBJECT(1454, "", Attachment5, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment6 = Range("i15")
If Attachment6 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj6 = AttachME.EMBEDOBJECT(1454, "", Attachment6, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment7 = Range("j15")
If Attachment7 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj7 = AttachME.EMBEDOBJECT(1454, "", Attachment7, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment8 = Range("k15")
If Attachment8 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj8 = AttachME.EMBEDOBJECT(1454, "", Attachment8, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment9 = Range("l15")
If Attachment9 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj9 = AttachME.EMBEDOBJECT(1454, "", Attachment9, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
On Error Resume Next
End If
Attachment10 = Range("m15")
If Attachment10 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
On Error Resume Next
Set EmbedObj10 = AttachME.EMBEDOBJECT(1454, "", Attachment10, "Attachment")
On Error Resume Next
MailDoc.CREATERICHTEXTITEM ("Attachment")
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
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing
Set EmbedObj6 = Nothing
Set EmbedObj7 = Nothing
Set EmbedObj8 = Nothing
Set EmbedObj9 = Nothing
Set EmbedObj10 = Nothing
Exit Sub
errorhandler1:
Application.Goto Reference:="IAddress"
CellLocation99 = ActiveSheet.Name & "!" & ActiveCell.Address
Worksheets("Address Complications").Select
Range("a1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell = CellLocation99
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing
Set EmbedObj6 = Nothing
Set EmbedObj7 = Nothing
Set EmbedObj8 = Nothing
Set EmbedObj9 = Nothing
Set EmbedObj10 = Nothing
End Sub