All,
This worked good also:
Sub ClientInfoEmailNew()
Dim strSendTo, strSubject, strText, strcc, strbcc As String
Dim strFile As String
strSendTo = ""
strSubject = ""
strText = ""
strFile = ""
NotesMailNewDraft strSendTo, strSubject, strText, strcc, strbcc, strFile
Exit Sub
20 Msg = "A draft E-Mail was not created! Please check your network connection and ensure you are logged into Lotus Notes."
MsgBox Msg, vbInformation, "Notesmail Draft..."
End Sub
Public Function NotesMailNewDraft(strSendTo As Variant, strSubject As Variant, strText As Variant, strcc As Variant, strbcc As Variant, strFilename As String)
Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc As Object
Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem
Dim Msg As String
On Error Resume Next
AppActivate "Lotus Notes"
If Not Err.Number = 0 Then
Err.Clear
GoTo ExitF
Else
On Error GoTo ExitF
Set objNotes = GetObject("", "Notes.Notessession")
Set objNotesDB = objNotes.GETDATABASE("", "")
Call objNotesDB.OPENMAIL
Set objNotesMailDoc = objNotesDB.CREATEDOCUMENT
objNotesMailDoc.Form = "Memo"
Call objNotesMailDoc.Save(True, False)
Set SendItem = objNotesMailDoc.APPENDITEMVALUE("SendTo", "")
Set NCopyItem = objNotesMailDoc.APPENDITEMVALUE("CopyTo", "")
Set BlindCopyToItem = objNotesMailDoc.APPENDITEMVALUE("BlindCopyTo", "")
objNotesMailDoc.SendTo = Application.Worksheets("Client Information").Range("EmailAddress").value
objNotesMailDoc.Subject = Application.Worksheets("Client Information").Range("ProjectName").value & " " & Application.Worksheets("Client Information").Range("ProjectNumber").value
Set rtitem = objNotesMailDoc.CREATERICHTEXTITEM("Body")
objNotesMailDoc.Body = Application.Worksheets("Client Information").Range("ContactName").value & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & " " & vbCr & "Regards" & vbCr & " " & vbCr & Application.Worksheets("Client Information").Range("SalesEng").value & vbCr & "WWL"
rtitem.ADDNEWLINE (1)
Call objNotesMailDoc.Save(True, False)
objNotesMailDoc.RemoveItem ("DeliveredDate")
Call objNotesMailDoc.Save(True, False)
Msg = "A draft E-Mail was successfully created and can be found in your Notes Drafts folder!"
MsgBox Msg, vbInformation, "Notesmail Draft..."
Call objNotes.Close
Set objNotes = Nothing
Exit Function
End If
ExitF:
Msg = "A draft E-Mail was not created! Please check your network connection and ensure you are logged into Lotus Notes."
MsgBox Msg, vbInformation, "Notesmail Draft..."
End Function