| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Saving emails sent by Lotus Notes through Excel
I have a spreadsheet with some coding in it to send an email via Lotus Notes.
This all works fine to send, but I am having a slight problem with part of it. As a workaround to sending to multiple people (instead of using checkboxes etc) I just put a loop in to action on the result of a message box, so after the first sending a message box pops up asking if they want to send to another recipient, and if so loops through the code again. This all works fine, apart from the fact that when I check my Sent box in Lotus Notes it only saves the latest email sent, and not all of them. Is there anything I can do to correct this, and get it saving all the emails sent? My code is as follows: Sub emailer() With application .ScreenUpdating = False .DisplayAlerts = False End With TodaysDate = Date ActiveWorkbook.SaveAs ("U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls") savedworkbook = "U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls" If ActiveWorkbook.Saved = False Then GoTo ExitSub On Error GoTo ExitSub user = application.UserName Mid(user, 1, 1) = UCase(Mid(user, 1, 1)) For counter = 1 To Len(user) If Mid(user, counter, 1) = "." Then Mid(user, counter, 1) = " " Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1)) End If Next counter ' Declare Variables for file and macro setup Dim UserName As String Dim MailDbName As String Dim Maildb As Object Dim MailDoc As Object Dim AttachME As Object 'Attachment bit Dim Session As Object Dim EmbedObj1 As Object 'Attachment bit Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen = True Then Else Maildb.OPENMAIL End If Maildb.CreateDocument Set MailDoc = Maildb.CreateDocument MailDoc.Form = "Memo" MailDoc.from = Sheets("Summary").Range("C6").Value MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value MailDoc.principal = Sheets("Summary").Range("C6").Value MailDoc.Body = "" 'Sheets("email wording").Range("a1").Value attachment1 = savedworkbook 'Attachment bit Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1") Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", attachment1, "") application.ScreenUpdating = True 'End Attachment bit MailDoc.SaveMessageOnSend = True On Error GoTo 0 sent = False SendBit: MailDoc.SaveMessageOnSend = True While sent = False On Error GoTo IncorrectAddressee emailto = InputBox("Please enter the Lotus Notes name of who you would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR will need authorisation first)", "Email Addressee", "") '"Enter Details Here....") If emailto = Cancel Then Exit Sub MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value Call MailDoc.Send(False) If ErrorMessage1 = "" Then sent = True ErrorMessage1 = "" Else sent = False ErrorMessage1 = "" End If MailDoc.SaveMessageOnSend = True GoTo sentok IncorrectAddressee: ErrorMessage1 = MsgBox("This form has not been submitted. Please check the Lotus Notes name of the recipient and try again.", vbOKOnly, "Incorrect Lotus Notes name") Resume Next sentok: Wend MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo, "Multiple Recipients") If MoreRecipients = vbYes Then sent = False GoTo SendBit Else MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly, "Email Success") End If Exit Sub ExitSub: MsgBox ("This form has not been submitted. Please fill in all the required fields and try again.") application.ScreenUpdating = True application.DisplayAlerts = True Exit Sub End Sub Ta, cdb |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Saving emails sent by Lotus Notes through Excel
Excert from my code for a Lotus Notes application
With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True <<<<<< .PostedDate = Now() .send 0, vaRecipients End With HTH "cdb" wrote: I have a spreadsheet with some coding in it to send an email via Lotus Notes. This all works fine to send, but I am having a slight problem with part of it. As a workaround to sending to multiple people (instead of using checkboxes etc) I just put a loop in to action on the result of a message box, so after the first sending a message box pops up asking if they want to send to another recipient, and if so loops through the code again. This all works fine, apart from the fact that when I check my Sent box in Lotus Notes it only saves the latest email sent, and not all of them. Is there anything I can do to correct this, and get it saving all the emails sent? My code is as follows: Sub emailer() With application .ScreenUpdating = False .DisplayAlerts = False End With TodaysDate = Date ActiveWorkbook.SaveAs ("U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls") savedworkbook = "U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls" If ActiveWorkbook.Saved = False Then GoTo ExitSub On Error GoTo ExitSub user = application.UserName Mid(user, 1, 1) = UCase(Mid(user, 1, 1)) For counter = 1 To Len(user) If Mid(user, counter, 1) = "." Then Mid(user, counter, 1) = " " Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1)) End If Next counter ' Declare Variables for file and macro setup Dim UserName As String Dim MailDbName As String Dim Maildb As Object Dim MailDoc As Object Dim AttachME As Object 'Attachment bit Dim Session As Object Dim EmbedObj1 As Object 'Attachment bit Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen = True Then Else Maildb.OPENMAIL End If Maildb.CreateDocument Set MailDoc = Maildb.CreateDocument MailDoc.Form = "Memo" MailDoc.from = Sheets("Summary").Range("C6").Value MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value MailDoc.principal = Sheets("Summary").Range("C6").Value MailDoc.Body = "" 'Sheets("email wording").Range("a1").Value attachment1 = savedworkbook 'Attachment bit Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1") Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", attachment1, "") application.ScreenUpdating = True 'End Attachment bit MailDoc.SaveMessageOnSend = True On Error GoTo 0 sent = False SendBit: MailDoc.SaveMessageOnSend = True While sent = False On Error GoTo IncorrectAddressee emailto = InputBox("Please enter the Lotus Notes name of who you would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR will need authorisation first)", "Email Addressee", "") '"Enter Details Here....") If emailto = Cancel Then Exit Sub MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value Call MailDoc.Send(False) If ErrorMessage1 = "" Then sent = True ErrorMessage1 = "" Else sent = False ErrorMessage1 = "" End If MailDoc.SaveMessageOnSend = True GoTo sentok IncorrectAddressee: ErrorMessage1 = MsgBox("This form has not been submitted. Please check the Lotus Notes name of the recipient and try again.", vbOKOnly, "Incorrect Lotus Notes name") Resume Next sentok: Wend MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo, "Multiple Recipients") If MoreRecipients = vbYes Then sent = False GoTo SendBit Else MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly, "Email Success") End If Exit Sub ExitSub: MsgBox ("This form has not been submitted. Please fill in all the required fields and try again.") application.ScreenUpdating = True application.DisplayAlerts = True Exit Sub End Sub Ta, cdb |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Saving emails sent by Lotus Notes through Excel
Cheers for this, but I already have the 'SaveMessageOnSend = True' line of
code in my code. This does save the email, but it only saves the last one (whereas, as the code loops through I'd like it to save each email sent, instead of overwriting the existing one with the new data) "steve_doc" wrote: Excert from my code for a Lotus Notes application With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True <<<<<< .PostedDate = Now() .send 0, vaRecipients End With HTH "cdb" wrote: I have a spreadsheet with some coding in it to send an email via Lotus Notes. This all works fine to send, but I am having a slight problem with part of it. As a workaround to sending to multiple people (instead of using checkboxes etc) I just put a loop in to action on the result of a message box, so after the first sending a message box pops up asking if they want to send to another recipient, and if so loops through the code again. This all works fine, apart from the fact that when I check my Sent box in Lotus Notes it only saves the latest email sent, and not all of them. Is there anything I can do to correct this, and get it saving all the emails sent? My code is as follows: Sub emailer() With application .ScreenUpdating = False .DisplayAlerts = False End With TodaysDate = Date ActiveWorkbook.SaveAs ("U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls") savedworkbook = "U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls" If ActiveWorkbook.Saved = False Then GoTo ExitSub On Error GoTo ExitSub user = application.UserName Mid(user, 1, 1) = UCase(Mid(user, 1, 1)) For counter = 1 To Len(user) If Mid(user, counter, 1) = "." Then Mid(user, counter, 1) = " " Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1)) End If Next counter ' Declare Variables for file and macro setup Dim UserName As String Dim MailDbName As String Dim Maildb As Object Dim MailDoc As Object Dim AttachME As Object 'Attachment bit Dim Session As Object Dim EmbedObj1 As Object 'Attachment bit Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen = True Then Else Maildb.OPENMAIL End If Maildb.CreateDocument Set MailDoc = Maildb.CreateDocument MailDoc.Form = "Memo" MailDoc.from = Sheets("Summary").Range("C6").Value MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value MailDoc.principal = Sheets("Summary").Range("C6").Value MailDoc.Body = "" 'Sheets("email wording").Range("a1").Value attachment1 = savedworkbook 'Attachment bit Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1") Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", attachment1, "") application.ScreenUpdating = True 'End Attachment bit MailDoc.SaveMessageOnSend = True On Error GoTo 0 sent = False SendBit: MailDoc.SaveMessageOnSend = True While sent = False On Error GoTo IncorrectAddressee emailto = InputBox("Please enter the Lotus Notes name of who you would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR will need authorisation first)", "Email Addressee", "") '"Enter Details Here....") If emailto = Cancel Then Exit Sub MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value Call MailDoc.Send(False) If ErrorMessage1 = "" Then sent = True ErrorMessage1 = "" Else sent = False ErrorMessage1 = "" End If MailDoc.SaveMessageOnSend = True GoTo sentok IncorrectAddressee: ErrorMessage1 = MsgBox("This form has not been submitted. Please check the Lotus Notes name of the recipient and try again.", vbOKOnly, "Incorrect Lotus Notes name") Resume Next sentok: Wend MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo, "Multiple Recipients") If MoreRecipients = vbYes Then sent = False GoTo SendBit Else MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly, "Email Success") End If Exit Sub ExitSub: MsgBox ("This form has not been submitted. Please fill in all the required fields and try again.") application.ScreenUpdating = True application.DisplayAlerts = True Exit Sub End Sub Ta, cdb |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Saving emails sent by Lotus Notes through Excel
Out of intrest, while stepping through your code, does it still only save the
last email sent? Trying to delve into your code, it looks like you are sending 1 email to multiple parties (please correct me if I am wrong). The way I approached this is slightly different -- Abrieviated code Below Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "") 'If Lotus Notes is not open then open the mail-part of it. If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Do Until IsEmpty(rg) AppName = rg.Offset(0, 3) vaMsg = "some message here" vaRecipients = rg.Offset(0, 2) 'Create the e-mail and add the attachment. Set noDocument = noDatabase.CreateDocument 'Add values to the created e-mail main properties. With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True .PostedDate = Now() .send 0, vaRecipients End With IncreaseRange: Set rg = rg.Offset(1, 0) vaMsg = "" Loop MsgBox ("The e-mails have successfully been created and distributed."), vbInformation ExitSub: 'Release objects from memory. Set noEmbedObject = Nothing Set noAttachment = Nothing Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing Set rg = Nothing Set wsSheet = Nothing Set wb = Nothing Exit Sub Error_Handling: MsgBox "Error number: " & Err.Number & vbNewLine & _ "Description: " & Err.Description, vbOKOnly Resume ExitSub the above works from me in what I need to do, and saves a copy of each email sent. I appreciate that what you are trying to achieve is not the same as what I am, but feel free to set up a test with my code and modify to fit yours HTH "cdb" wrote: Cheers for this, but I already have the 'SaveMessageOnSend = True' line of code in my code. This does save the email, but it only saves the last one (whereas, as the code loops through I'd like it to save each email sent, instead of overwriting the existing one with the new data) "steve_doc" wrote: Excert from my code for a Lotus Notes application With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True <<<<<< .PostedDate = Now() .send 0, vaRecipients End With HTH "cdb" wrote: I have a spreadsheet with some coding in it to send an email via Lotus Notes. This all works fine to send, but I am having a slight problem with part of it. As a workaround to sending to multiple people (instead of using checkboxes etc) I just put a loop in to action on the result of a message box, so after the first sending a message box pops up asking if they want to send to another recipient, and if so loops through the code again. This all works fine, apart from the fact that when I check my Sent box in Lotus Notes it only saves the latest email sent, and not all of them. Is there anything I can do to correct this, and get it saving all the emails sent? My code is as follows: Sub emailer() With application .ScreenUpdating = False .DisplayAlerts = False End With TodaysDate = Date ActiveWorkbook.SaveAs ("U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls") savedworkbook = "U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls" If ActiveWorkbook.Saved = False Then GoTo ExitSub On Error GoTo ExitSub user = application.UserName Mid(user, 1, 1) = UCase(Mid(user, 1, 1)) For counter = 1 To Len(user) If Mid(user, counter, 1) = "." Then Mid(user, counter, 1) = " " Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1)) End If Next counter ' Declare Variables for file and macro setup Dim UserName As String Dim MailDbName As String Dim Maildb As Object Dim MailDoc As Object Dim AttachME As Object 'Attachment bit Dim Session As Object Dim EmbedObj1 As Object 'Attachment bit Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen = True Then Else Maildb.OPENMAIL End If Maildb.CreateDocument Set MailDoc = Maildb.CreateDocument MailDoc.Form = "Memo" MailDoc.from = Sheets("Summary").Range("C6").Value MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value MailDoc.principal = Sheets("Summary").Range("C6").Value MailDoc.Body = "" 'Sheets("email wording").Range("a1").Value attachment1 = savedworkbook 'Attachment bit Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1") Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", attachment1, "") application.ScreenUpdating = True 'End Attachment bit MailDoc.SaveMessageOnSend = True On Error GoTo 0 sent = False SendBit: MailDoc.SaveMessageOnSend = True While sent = False On Error GoTo IncorrectAddressee emailto = InputBox("Please enter the Lotus Notes name of who you would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR will need authorisation first)", "Email Addressee", "") '"Enter Details Here....") If emailto = Cancel Then Exit Sub MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value Call MailDoc.Send(False) If ErrorMessage1 = "" Then sent = True ErrorMessage1 = "" Else sent = False ErrorMessage1 = "" End If MailDoc.SaveMessageOnSend = True GoTo sentok IncorrectAddressee: ErrorMessage1 = MsgBox("This form has not been submitted. Please check the Lotus Notes name of the recipient and try again.", vbOKOnly, "Incorrect Lotus Notes name") Resume Next sentok: Wend MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo, "Multiple Recipients") If MoreRecipients = vbYes Then sent = False GoTo SendBit Else MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly, "Email Success") End If Exit Sub ExitSub: MsgBox ("This form has not been submitted. Please fill in all the required fields and try again.") application.ScreenUpdating = True application.DisplayAlerts = True Exit Sub End Sub Ta, cdb |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Saving emails sent by Lotus Notes through Excel
When I step through it, it saves the current one, until the next one is sent
overwriting it with that one and so on. Cheers for the code - will give it a look at work tomorrow. "steve_doc" wrote: Out of intrest, while stepping through your code, does it still only save the last email sent? Trying to delve into your code, it looks like you are sending 1 email to multiple parties (please correct me if I am wrong). The way I approached this is slightly different -- Abrieviated code Below Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "") 'If Lotus Notes is not open then open the mail-part of it. If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Do Until IsEmpty(rg) AppName = rg.Offset(0, 3) vaMsg = "some message here" vaRecipients = rg.Offset(0, 2) 'Create the e-mail and add the attachment. Set noDocument = noDatabase.CreateDocument 'Add values to the created e-mail main properties. With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True .PostedDate = Now() .send 0, vaRecipients End With IncreaseRange: Set rg = rg.Offset(1, 0) vaMsg = "" Loop MsgBox ("The e-mails have successfully been created and distributed."), vbInformation ExitSub: 'Release objects from memory. Set noEmbedObject = Nothing Set noAttachment = Nothing Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing Set rg = Nothing Set wsSheet = Nothing Set wb = Nothing Exit Sub Error_Handling: MsgBox "Error number: " & Err.Number & vbNewLine & _ "Description: " & Err.Description, vbOKOnly Resume ExitSub the above works from me in what I need to do, and saves a copy of each email sent. I appreciate that what you are trying to achieve is not the same as what I am, but feel free to set up a test with my code and modify to fit yours HTH "cdb" wrote: Cheers for this, but I already have the 'SaveMessageOnSend = True' line of code in my code. This does save the email, but it only saves the last one (whereas, as the code loops through I'd like it to save each email sent, instead of overwriting the existing one with the new data) "steve_doc" wrote: Excert from my code for a Lotus Notes application With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True <<<<<< .PostedDate = Now() .send 0, vaRecipients End With HTH "cdb" wrote: I have a spreadsheet with some coding in it to send an email via Lotus Notes. This all works fine to send, but I am having a slight problem with part of it. As a workaround to sending to multiple people (instead of using checkboxes etc) I just put a loop in to action on the result of a message box, so after the first sending a message box pops up asking if they want to send to another recipient, and if so loops through the code again. This all works fine, apart from the fact that when I check my Sent box in Lotus Notes it only saves the latest email sent, and not all of them. Is there anything I can do to correct this, and get it saving all the emails sent? My code is as follows: Sub emailer() With application .ScreenUpdating = False .DisplayAlerts = False End With TodaysDate = Date ActiveWorkbook.SaveAs ("U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls") savedworkbook = "U:\Recruitment Campaign Request " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" & Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls" If ActiveWorkbook.Saved = False Then GoTo ExitSub On Error GoTo ExitSub user = application.UserName Mid(user, 1, 1) = UCase(Mid(user, 1, 1)) For counter = 1 To Len(user) If Mid(user, counter, 1) = "." Then Mid(user, counter, 1) = " " Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1)) End If Next counter ' Declare Variables for file and macro setup Dim UserName As String Dim MailDbName As String Dim Maildb As Object Dim MailDoc As Object Dim AttachME As Object 'Attachment bit Dim Session As Object Dim EmbedObj1 As Object 'Attachment bit Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen = True Then Else Maildb.OPENMAIL End If Maildb.CreateDocument Set MailDoc = Maildb.CreateDocument MailDoc.Form = "Memo" MailDoc.from = Sheets("Summary").Range("C6").Value MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: " & Sheets("Summary").Range("C10").Value & ", " & Sheets("Summary").Range("C57").Value MailDoc.principal = Sheets("Summary").Range("C6").Value MailDoc.Body = "" 'Sheets("email wording").Range("a1").Value attachment1 = savedworkbook 'Attachment bit Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1") Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", attachment1, "") application.ScreenUpdating = True 'End Attachment bit MailDoc.SaveMessageOnSend = True On Error GoTo 0 sent = False SendBit: MailDoc.SaveMessageOnSend = True While sent = False On Error GoTo IncorrectAddressee emailto = InputBox("Please enter the Lotus Notes name of who you would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR will need authorisation first)", "Email Addressee", "") '"Enter Details Here....") If emailto = Cancel Then Exit Sub MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value Call MailDoc.Send(False) If ErrorMessage1 = "" Then sent = True ErrorMessage1 = "" Else sent = False ErrorMessage1 = "" End If MailDoc.SaveMessageOnSend = True GoTo sentok IncorrectAddressee: ErrorMessage1 = MsgBox("This form has not been submitted. Please check the Lotus Notes name of the recipient and try again.", vbOKOnly, "Incorrect Lotus Notes name") Resume Next sentok: Wend MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo, "Multiple Recipients") If MoreRecipients = vbYes Then sent = False GoTo SendBit Else MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly, "Email Success") End If Exit Sub ExitSub: MsgBox ("This form has not been submitted. Please fill in all the required fields and try again.") application.ScreenUpdating = True application.DisplayAlerts = True Exit Sub End Sub Ta, cdb |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Has anyone sent emails from Excel via Lotus Notes? | Excel Discussion (Misc queries) | |||
| Mail über Lotus Notes aus Excel heraus/ Sending Mail with Excel through Lotus Notes | Excel Programming | |||
| Lotus Notes Doc link in Excel?? | Excel Programming | |||
| Excel/Lotus Notes | Excel Programming | |||
| Emailing Lotus Notes From Excel | Excel Programming | |||
Hybrid Mode
