Macro to send email through Lotus Notes

P

PCLIVE

Is there a way to control the text properties of the body text? For
example: bold, italics, underlined, etc.

I've got code like this to enter the body text.

.APPENDTEXT "This is a test."
.addnewline 1


Is there a way to have the macro control the text properties? Is it
possible to force "This is a test." to be bold in the email, via the macro?


Thanks,
Paul
 
P

PCLIVE

Thanks Ron. It is some of your code that I originally used when I started
this project of zipping a file, attaching it to an email and sending it. I
appreciate all of your help in the past. However, I'm having trouble
grasping this one. I've looked at the code offered in your suggestions.
Unfortunately haven't found what I'm looking for. It doesn't seem that what
I am trying to do will be easy. I've had everything working without trying
to change the text appearance in the body of the outgoing email. However, I
now have the need to emphasize the text in different sections and thought
that it may be some simple coding. I guess it's not as simple as just
adding a few tag-lines to the .APPENDTEXT lines. If you have any other
suggestions, they are certainly welcome.

Thanks again.
Paul
 
R

Ron de Bruin

Have you try this ?

If you want to create emails that are formatted you can use HTMLBody (Office 2000 and up) instead of TextBody .
You can find a lot of WebPages on the internet with more HTML tags examples.

.HTMLBody = "<H3><B>Dear Ron de Bruin</B></H3>" & _
"Please visit this website to download an update.<BR>" & _
"<A HREF=""http://www.rondebruin.nl/"">Ron's Excel Page</A>"
 
P

PCLIVE

I did try that before, but I just tried it again with the same result.

I get an error stating:
"Error # 438 was generated by VBAProject
Object doesn't support this property or method"

I'm not sure if there is something else I need in order to use the .HTMLBody
option.
 
P

PCLIVE

I'm sure I didn't use your HTMLBody code properly, but here it is.


Function SendEMailOnly()

Application.Calculate

If Sheets("Setup").Visible = True Then Sheets("Setup").Visible = False
Sheets(3).Select

If Sheets("Setup").Range("L2").Value = "Jan" Then GoTo MsgMonthly
Workbooks.Open Sheets("Setup").Range("AI11").Value
If Sheets("Setup").Visible = True Then Sheets("Setup").Visible = False
Sheets(3).Select

ActiveWorkbook.Save
ActiveWorkbook.Close

MsgMonthly:
Msg = "Please log on to the Service server and click Yes. If you are
already logged on, click Yes to continue. If you do not wish to continue,
click No to cancel the operation." ' Define message.
style = vbYesNo ' Define buttons.
Title = "Confirm Server Connection" ' Define title.
If MsgBox(Msg, style, Title) = vbNo Then End

If Sheets("Setup").Range("L2").Value = "Jan" Then
Msg = "Are you sure you want to send an email announcing the
availability of the " & Sheets("Setup").Range("AI7").Value & " Monthly
report to " & Sheets("Setup").Range("AZ1").Value & "?"

If MsgBox(Msg, style, Title) = vbNo Then End


Else: Msg = "Are you sure you want to send an email announcing the
availability of the " & Sheets("Setup").Range("AI7").Value & " Monthly & YTD
reports to " & Sheets("Setup").Range("AZ1").Value & "?" ' Define message.
style = vbYesNo ' Define buttons.
Title = "Confirm Message Send" ' Define title.
If MsgBox(Msg, style, Title) = vbNo Then End
End If

'ActiveWorkbook.SaveCopyAs ("\\Network ServerReports\Monthly Reports\" & _
Sheets("Setup").Range("Z2").Value & "\" &
Sheets("Setup").Range("F3").Value & "\" & ActiveWorkbook.Name)



Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object




On Error GoTo SendMailError


EMailSendTo = Sheets("Setup").Range("AZ1").Value
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
If Sheets("Setup").Range("L2").Value = "Jan" _
Then EmailSubject = "Monthly " & Sheets("Setup").Range("AI7").Value & "
Analysis report availability for the month of " &
Sheets("Setup").Range("V7").Value & " " & Sheets("Setup").Range("F3").Value
_
Else EmailSubject = "Monthly and YTD " &
Sheets("Setup").Range("AI7").Value & " Analysis report availability for the
month of " & Sheets("Setup").Range("V7").Value & " " &
Sheets("Setup").Range("F3").Value
''Establish Connection to Notes
Set objNotesSession = CreateObject("Notes.NotesSession")

''Establish Connection to Mail File
'' .GETDATABASE("SERVER", "FILE")
Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
''Open Mail
objNotesMailFile.OPENMAIL

''Create New Memo
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT

''Create 'Subject Field'
Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject",
EmailSubject)

''Create 'Send To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)

''Create 'Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)

''Create 'Blind Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)

''Create 'Body' of memo
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")



With objNotesField

If Sheets("Setup").Range("L2").Value = "Jan" Then
.APPENDTEXT Sheets("Setup").Range("AI7").Value & " Monthly
Analysis Report - " & _
Sheets("Setup").Range("V7").Value & " " &
Sheets("Setup").Range("F3").Value & _
" - Available in the following locations."
.addnewline 1
.APPENDTEXT "Drive:"
.addnewline 1
.APPENDTEXT Sheets("Setup").Range("AI10").Value
.addnewline 2
.APPENDTEXT "Network Drive:"
.addnewline 1
.APPENDTEXT " " & Sheets("Setup").Range("AI13").Value
.addnewline 3
.APPENDTEXT "Note: There is no Year To Date (YTD) file for
January since this is the first month of the year."
Else: .APPENDTEXT Sheets("Setup").Range("AI7").Value & " Monthly
Analysis Report - " & _
Sheets("Setup").Range("V7").Value & " " &
Sheets("Setup").Range("F3").Value & _
" - Available in the following locations."
.addnewline 1
.APPENDTEXT "Drive2"
.addnewline 1
.APPENDTEXT Sheets("Setup").Range("AI10").Value
.addnewline 2
.APPENDTEXT "Network Drive:"
.addnewline 1
.APPENDTEXT " " & Sheets("Setup").Range("AI13").Value
.addnewline 3
.APPENDTEXT "Year To Date (YTD) " &
Sheets("Setup").Range("AI7").Value & _
" Analysis Report - January-" &
Sheets("Setup").Range("V7").Value _
& " " & Sheets("Setup").Range("F3").Value & " -
Available in the following locations."
.addnewline 1
.APPENDTEXT "Drive2"
.addnewline 1
.APPENDTEXT " " & Sheets("Setup").Range("AI11").Value
.addnewline 2
.APPENDTEXT "Network Drive:"
.addnewline 1
.APPENDTEXT " " & Sheets("Setup").Range("AI14").Value
.addnewline 3
.HTMLBody = "<H3><B>Dear Ron de Bruin</B></H3>" & _
"Please visit this website to download an update.<BR>" &
_
"<A HREF=""http://www.rondebruin.nl/"">Ron's Excel
Page</A>"


End If

End With

objNotesField.addnewline 1

If Sheets("Setup").Range("L2").Value = "Jan" Then GoTo SkipYTD
'objNotesField = objNotesField.EMBEDOBJECT(1454, "",
Sheets("Setup").Range("AI6").Value)

SkipYTD:
''Send the e-mail
objNotesDocument.SaveMessageOnSend = True ' save in Sent folder
objNotesDocument.Send (0)




''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing

''Set return code
SendMail = True


MsgBox "Your Lotus Notes message was successfully sent ..." & _
Chr$(13) & _
Chr$(13) & _
"A copy can be found in your Sent folder", vbInformation, "Email Send
Status"

Exit Function


SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

SendMail = False

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top