Christowl
05-19-2015, 04:26 AM
Hi Folks,
Been a while since I've been on here so hope that you're all doing well.
I've been working on an application (Excel 2013) at work that will effectively validate entries, protect the document, save it to a new folder and then email (Lotus Notes) it to a range of people who are in a range on another sheet in the file.
I'm fairly close to completing (I think!) but I'm stuck when it comes to adding the attachment to the email and it seems once again file structures are screwing me. I'm not sure how I could but another possibility would be to change the code to attach the active document?
The code is below if anybody feels that they can help;
Sub SendNotesMail()
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim Session As Object
Dim AttachME As Object
Dim Recipient As String
Dim Subject1 As String
Dim MyFile As String
Dim ccRecipient As String
Set Session = CreateObject("Notes.NotesSession")
MyFile = Sheets("Request form").Range("F9").Text
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 = Sheets("control").Range("A2").Value
MailDoc.SendTo = Recipient
ccRecipient = Sheets("control").Range("A2").Value
MailDoc.CopyTo = ccRecipient
MailDoc.BlindCopyTo = Sheets("control").Range("A2:A4").Value
Subject1 = Sheets("control").Range("A2").Value
MailDoc.Subject = "Request for quotation"
MailDoc.Body = "Dear Supplier," & vbNewLine & vbNewLine & "Please find attached a request for quotation." & vbNewLine & vbNewLine & "King Regards," & vbNewLine & "Rob\Susanne"
MailDoc.SaveMessageOnSend = True
Attachment1 = "M:\Supply Chain\RFQ\" & MyFile
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", "M:\Supply Chain\RFQ\" & MyFile, "")
On Error Resume Next
End If
MailDoc.PostedDate = Now
Call MailDoc.Send(False)
Set Maildb = Nothing:
Set MailDoc = Nothing:
Set Session = Nothing
Exit Sub
End Sub
Before anyone asks, yes, I'm a newb lol :(
Thanks in advance,
Chris
Been a while since I've been on here so hope that you're all doing well.
I've been working on an application (Excel 2013) at work that will effectively validate entries, protect the document, save it to a new folder and then email (Lotus Notes) it to a range of people who are in a range on another sheet in the file.
I'm fairly close to completing (I think!) but I'm stuck when it comes to adding the attachment to the email and it seems once again file structures are screwing me. I'm not sure how I could but another possibility would be to change the code to attach the active document?
The code is below if anybody feels that they can help;
Sub SendNotesMail()
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim Session As Object
Dim AttachME As Object
Dim Recipient As String
Dim Subject1 As String
Dim MyFile As String
Dim ccRecipient As String
Set Session = CreateObject("Notes.NotesSession")
MyFile = Sheets("Request form").Range("F9").Text
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 = Sheets("control").Range("A2").Value
MailDoc.SendTo = Recipient
ccRecipient = Sheets("control").Range("A2").Value
MailDoc.CopyTo = ccRecipient
MailDoc.BlindCopyTo = Sheets("control").Range("A2:A4").Value
Subject1 = Sheets("control").Range("A2").Value
MailDoc.Subject = "Request for quotation"
MailDoc.Body = "Dear Supplier," & vbNewLine & vbNewLine & "Please find attached a request for quotation." & vbNewLine & vbNewLine & "King Regards," & vbNewLine & "Rob\Susanne"
MailDoc.SaveMessageOnSend = True
Attachment1 = "M:\Supply Chain\RFQ\" & MyFile
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", "M:\Supply Chain\RFQ\" & MyFile, "")
On Error Resume Next
End If
MailDoc.PostedDate = Now
Call MailDoc.Send(False)
Set Maildb = Nothing:
Set MailDoc = Nothing:
Set Session = Nothing
Exit Sub
End Sub
Before anyone asks, yes, I'm a newb lol :(
Thanks in advance,
Chris