From: Greg on 2 Jun 2010 12:33 Option Explicit Dim bcLotus As Office.CommandBarControl Sub Create_Lotus_Menu() Dim cbNew As Office.CommandBar Dim bcSendTo As Office.CommandBarControl 'This is a good approach when working with several language versions of Excel. 'Create the menu command on the File Menu. Set bcSendTo = CommandBars.FindControl(Type:=msoControlPopup, ID:=30002) Set cbNew = bcSendTo.CommandBar Set bcLotus = cbNew.Controls.Add 'Set the properties of the new created command. With bcLotus .BeginGroup = True .Caption = "Send workbook as attachment via Notes" .FaceId = 719 .OnAction = "SendWithLotus" .Tag = "Lotus" End With End Sub Sub Delete_Lotus_Menu() On Error Resume Next 'Delete the control from the File-menu. Set bcLotus = CommandBars.FindControl(, , Tag:="Lotus") bcLotus.Delete 'Restore the built-in errorhandling. On Error GoTo 0 End Sub Sub SendWithLotus() Dim noSession As Object, noDatabase As Object, noDocument As Object Dim obAttachment As Object, EmbedObject As Object Dim stSubject As Variant, stAttachment As String Dim vaRecipient As Variant, vaMsg As Variant Const EMBED_ATTACHMENT As Long = 1454 Const stTitle As String = "Active workbook status" Const stMsg As String = "The active workbook must first be saved " & vbCrLf _ & "before it can be sent as an attachment." 'Check if the active workbook is saved or not 'If the active workbook has not been saved at all. If Len(ActiveWorkbook.Path) = 0 Then MsgBox stMsg, vbInformation, stTitle Exit Sub End If 'If the changes in the active workbook have been saved or not. If ActiveWorkbook.Saved = False Then If MsgBox("Do you want to save the changes before sending? WARNING: IF DOCUMENT IS NOT SAVED ALL INPUT DATA WILL BE LOST", _ vbYesNo + vbInformation, stTitle) = vbYes Then _ ActiveWorkbook.Save End If 'Get the name of the recipient from the user. Do vaRecipient = Application.InputBox( _ Prompt:="Please add name of the recipient such as:" & vbCrLf _ & "gsavinda(a)elliott-turbo.com or jsutter(a)vendor.org", _ Title:="Recipient", Type:=2) Loop While vaRecipient = "" 'If the user has canceled the operation. If vaRecipient = False Then Exit Sub 'Get the message from the user. Do vaMsg = Application.InputBox( _ Prompt:="Please enter the message such as:" & vbCrLf _ & "Enclosed please find the gas parameters for PO# XXXX.", _ Title:="Message", Type:=2) Loop While vaMsg = "" 'If the user has canceled the operation. If vaMsg = False Then Exit Sub 'Add the subject to the outgoing e-mail 'which also can be retrieved from the users 'in a similar way as above. Do stSubject = Application.InputBox( _ Prompt:="Please add a subject such as:" & vbCrLf _ & "Gas Parameters .", _ Title:="Subject", Type:=2) Loop While stSubject = "" 'Retrieve the path and filename of the active workbook. stAttachment = ActiveWorkbook.FullName 'Instantiate the Lotus Notes COM's Objects. 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 'Create the e-mail and the attachment. Set noDocument = noDatabase.CreateDocument Set obAttachment = noDocument.CreateRichTextItem("stAttachment") Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment) 'Add values to the created e-mail main properties. With noDocument .Form = "Memo" .SendTo = vaRecipient .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True End With 'Send the e-mail. With noDocument .PostedDate = Now() .Send 0, vaRecipient End With 'Release objects from the memory. Set EmbedObject = Nothing Set obAttachment = Nothing Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing 'Activate Excel for the user. AppActivate "Microsoft Excel" MsgBox "The e-mail has successfully been created and distributed.", vbInformation End Sub Hope this helps Greg leere wrote: SendMail via Lotus Notes 15-Oct-08 Within Excel I have code that works well when sending mail via Outlook but not so when the email server is Lotus Notes. My Place of Work is entirly Lotus Notes Based and are not willing to change at present Does anyone have any code (possibly Function code) that could assist me in sending email via Lotus Notes I only need to use it for Excel, but with 2003 & 2007 versions of Excel I'am Praying...... Regards Previous Posts In This Thread: On Wednesday, October 15, 2008 6:00 PM leere wrote: SendMail via Lotus Notes Within Excel I have code that works well when sending mail via Outlook but not so when the email server is Lotus Notes. My Place of Work is entirly Lotus Notes Based and are not willing to change at present Does anyone have any code (possibly Function code) that could assist me in sending email via Lotus Notes I only need to use it for Excel, but with 2003 & 2007 versions of Excel I'am Praying...... Regards On Wednesday, October 15, 2008 6:22 PM James_Thomlinso wrote: RE: SendMail via Lotus Notes Check out sending mail via CDO... http://www.rondebruin.nl/cdo.htm -- HTH... Jim Thomlinson "leerem" wrote: On Wednesday, October 15, 2008 6:33 PM ="to" & CHAR(95) & "sheeloo" & CHAR(64) & "hotmail.com" wrote: RE: SendMail via Lotus Notes See http://www.fabalou.com/VBandVBA/lotusnotesmail.asp or http://www.forumtopics.com/busobj/viewtopic.php?t=26805 -- Always provide your feedback... "leerem" wrote: On Thursday, October 16, 2008 11:19 AM Ron de Bruin wrote: Re: SendMail via Lotus Notes For the OP CDO is a good option but See also this site for Notes code http://www.excelkb.com/?cNode=1X5M7A -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm Submitted via EggHeadCafe - Software Developer Portal of Choice Telerik RadControls For Silverlight (3 and 4) Q1 2010 http://www.eggheadcafe.com/tutorials/aspnet/6566fc91-a77c-4553-8ac2-7a7fa36e63a1/telerik-radcontrols-for-s.aspx
|
Pages: 1 Prev: calculate present value for future increase Next: Very slow to make changes in Excel 2007 sp2 |