Hi Everyone
I have borrowed some excellent code from an expert which allows me to send my worksheet as a .xls attachment in Lotus Notes (it's brill)
I have made one or two changes to suit my needs and to my suprise, some of my code actually works too!
However, my dilema is this. In a perfect world I would like to have the choice to email a .xls or a .pdf version of the worksheet. I would also like it to save a pdf version in the same way I have saved the .xls version. Is this possilbe?
I would accept it only sending and saving the pdf version on it's own, or not giving me the choice and emailing both the .xls and .pdf versions.
any advice would be greatly appreciated.
Please see the code below:
Sub SendWithLotus()
Dim ThisFile As String
Dim Thisfile2 As String
Dim WorkPath As String
Dim saveName As String
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?", _
vbYesNo + vbInformation, stTitle) = vbYes Then _
ThisFile = Range("AC5").Value '
Thisfile2 = Range("E3").Value '
WorkPath = "\My Documents\gas sheets"
saveName = WorkPath & "\" & ThisFile & " - " & Thisfile2 & ".xls"
ActiveWorkbook.SaveAs Filename:=saveName
End If
'Get the name of the recipient from the user.
Do
vaRecipient = Application.InputBox( _
Prompt:="Please type the name of the gas supervisor you are emailing:" & vbCrLf _
& "or the full address if they are not on the internal Haden mailing list.", _
Title:="Recipient", Type:=2)
Loop While vaRecipient = ""
'If the user has canceled the operation.
If vaRecipient = False Then Exit Sub
'The message is automatically put in to save confusion
vaMsg = "Please find attached the form: " & Thisfile2 & ", for maximo number: " & ThisFile
'Add the subject to the outgoing e-mail
Do
stSubject = Application.InputBox( _
Prompt:="Please add a subject such as:" & vbCrLf _
& "Weekly Report.", _
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
Bookmarks