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