1
I have an Access form that will automatically send out Emails through Lotus. Works like a charm for the sendto and the copyto. Is there a way I can also utilize the "blind copy to"? I appreciate any guidance! Thanks!
I tried to follow the same logic of the copy to, but can't seem to get it to work.
Note: The CopyName (ie. copy to) works already, but I tried to add BlindCopyName in also and can't get it to work.
I set all the variables here:
Dim SendContactName As String, SendCopyName As String, SendBlindCopyName As String, msg As String, SendSubject As String
Dim SendType As String
Dim db As DAO.Database
DoCmd.SetWarnings False
Set db = CurrentDb
Then I assign the variables for CopyName and a new variable I call BlindCopyName:
If IsNull(Forms!frmEdit!txtemail_pm) Then
Forms!frmEdit!txtemail_pm = "Nobody"
Else
SendCopyName = Forms!frmEdit!txtemail_pm ' This was Me.CopyName
End If
If IsNull(Forms!frmEdit!txtemail_hq) Then
Forms!frmEdit!txtemail_hq = "Nobody"
Else
SendBlindCopyName = Forms!frmEdit!txtemail_hq
End If
Next, I pass the variable to the email function, which I call:
Call SendStatusReport(SendContactName, SendCopyName, SendBlindCopyName, msg, SendSubject)
Finally, this is my Email Sub:
Public Sub SendStatusReport(ContactName, CopyName, BlindCopyName, Msgs, Subject)
Dim mailDb As Object, Attachment As String
Dim UserName As String, Recipient As Variant, Recipient2 As Variant
Dim MailDbName As String
Dim mailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rc As Long, strUn As String, nSize As Long, rec As Long
Dim strTitle As String
'Dim recip(25) As Variant
On Error GoTo NoSend
Set Session = CreateObject("notes.NotesSession")
UserName = Session.UserName
Set mailDb = Session.GETDATABASE("", "")
On Error Resume Next
If mailDb.IsOpen = True Then
Else
Call mailDb.OPENMAIL
End If
Set mailDoc = mailDb.CREATEDOCUMENT
mailDoc.Form = "Memo"
Recipient = ContactName
mailDoc.sendto = Recipient
Recipient2 = BlindCopyName
mailDoc.blindcopyto = Recipient2
If IsNull(CopyName) Then
mailDoc.copyto = "Nobody"
Else
mailDoc.copyto = CopyName
End If
If IsNull(BlindCopyName) Then
mailDoc.blindcopyto = "Nobody"
Else
mailDoc.blindcopyto = BlindCopyName
End If
Attachment = "c:\temp\ProjectStatusUpdate.rtf"
Set AttachME = mailDoc.CREATERICHTEXTITEM(Attachment)
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
mailDoc.CREATERICHTEXTITEM ("Attachment")
Dim frmSubject As String
Dim frmBody As String
frmSubject = "Task Reminder for: " & Subject
frmBody = "This is a system generated email notifying you that the Project (referenced in the subject of this email)" & vbCrLf & "has had a Status Level update or change."
frmBody = frmBody & vbCrLf & vbCrLf & Msgs & vbCrLf
mailDoc.Subject = frmSubject
mailDoc.Body = frmBody
mailDoc.SAVEMESSAGEONSEND = True
mailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
mailDoc.Send 0, Recipient
'Call mailDoc.Save(True, False)
NoSendExit:
Set mailDb = Nothing
Set mailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Exit Sub
NoSend:
MsgBox "Error sending mail. Check your Send Folder under Lotus Notes to see if the email was sent.", , "Problem Sending Email"
GoTo NoSendExit
End Sub
