Ajit Singh
Registered User.
- Local time
- Today, 01:41
- Joined
- Jul 11, 2013
- Messages
- 34
Am using below code to send Lotus Notes emails from Access 2010 and its working fine except few desktops. In couple of machines am encountering Run Time Errror 13 : Type Mismatch in this line "If Not !emailTo Then". Please help
Function sendEmail()
'Public Sub SendLotusNotesMail(strMailTitle As String, strLotusNotesUserID As String, strTextBody As String, Optional strFileAttachment As String = "", Optional fSaveMailToTheSentFolder As Boolean = False)
Dim objAttachment As Object
Dim objMailDb As Object
Dim objMailDocument As Object
Dim objEmbedObject As Object
Dim objNotesSession As Object
Dim strMailDbName As String
Dim Body As Object
Dim Body2 As Object
Dim Body3 As Object
On Error Resume Next
'Start objNotesSession in Lotus Notes
Set objNotesSession = CreateObject("Notes.NotesSession")
'Open the mail database in Lotus Notes
'strMailDbName = "mail\s\sin21757.nsf"
Set objMailDb = objNotesSession.GETDATABASE("", strMailDbName)
objMailDb.OPENMAIL
'Set up the new mail document
Dim rst As DAO.Recordset
Dim SendStatus As String
Dim sendTo As String
Dim CopyTo As String
Dim MailBody As String
Dim MailBody2 As String
Dim MailBody3 As String
Dim MailSubject As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim Attachment3 As String
Dim Attachment4 As String
Dim Attachment5 As String
Set rst = CurrentDb.OpenRecordset("tbl_email_distribution", dbOpenSnapshot)
With rst
Do Until .EOF
sendTo = !emailTo
If Not !emailTo Then
!emailTo = sendTo
Else
sendTo = ""
End If
CopyTo = !emailCC
If Not !emailCC Then
!emailCC = CopyTo
Else
CopyTo = ""
End If
If sendTo = "" And CopyTo = "" Then
MsgBox "Email Sent"
Exit Function
End If
DoCmd.OpenForm "email_body"
''MailBody = Forms!email_body!email_body.Caption
MailBody2 = Forms!email_body!email_body2.Caption
MailBody = Forms!email_distribution!emailBody
MailBody3 = Forms!email_body!email_body3.Caption
MailSubject = !emailSubject
Attachment1 = !AttachmentPath1
Attachment2 = !AttachmentPath2
Attachment3 = !AttachmentPath3
Attachment4 = !AttachmentPath4
Attachment5 = !AttachmentPath5
SendStatus = !send
'-------------------------------------------------------
If SendStatus = True Then
Set objMailDocument = objMailDb.CREATEDOCUMENT
objMailDocument.Form = "Memo"
objMailDocument.principal = "FP&A Central Support/FluorCorp"
objMailDocument.sendTo = Split(sendTo, ",")
objMailDocument.CopyTo = Split(CopyTo, ",")
objMailDocument.subject = MailSubject
objMailDocument.Body = MailBody2 & MailBody & MailBody3
objMailDocument.SAVEMESSAGEONSEND = True
'Set up the embedded object and strFileAttachment and attach it
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment1")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
objMailDocument.CREATERICHTEXTITEM ("Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment2")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment2, "Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment3")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment3, "Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment4")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment4, "Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment5")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment5, "Attachment")
End If
'Send the document
objMailDocument.PostedDate = Now()
objMailDocument.send 0, Split(sendTo, ",")
'objMailDocument.send 0, Split(CopyTo, ",")
'objMailDocument.Save True, True, False
'CreateObject("Notes.NotesUIWorkspace").EDITDOCUMENT True, objMailDocument
'objMailDocument "> " & Subject
End If
'-------------------------------------------------------
DoCmd.close acForm, "email_body"
.MoveNext
Loop
.close
End With
'Clean Up
Set rst = Nothing
Set objMailDb = Nothing
Set objMailDocument = Nothing
Set objAttachment = Nothing
Set objNotesSession = Nothing
Set objEmbedObject = Nothing
Set Body = Nothing
Set Body2 = Nothing
Set Body3 = Nothing
MsgBox "Email Sent"
End Function
Function sendEmail()
'Public Sub SendLotusNotesMail(strMailTitle As String, strLotusNotesUserID As String, strTextBody As String, Optional strFileAttachment As String = "", Optional fSaveMailToTheSentFolder As Boolean = False)
Dim objAttachment As Object
Dim objMailDb As Object
Dim objMailDocument As Object
Dim objEmbedObject As Object
Dim objNotesSession As Object
Dim strMailDbName As String
Dim Body As Object
Dim Body2 As Object
Dim Body3 As Object
On Error Resume Next
'Start objNotesSession in Lotus Notes
Set objNotesSession = CreateObject("Notes.NotesSession")
'Open the mail database in Lotus Notes
'strMailDbName = "mail\s\sin21757.nsf"
Set objMailDb = objNotesSession.GETDATABASE("", strMailDbName)
objMailDb.OPENMAIL
'Set up the new mail document
Dim rst As DAO.Recordset
Dim SendStatus As String
Dim sendTo As String
Dim CopyTo As String
Dim MailBody As String
Dim MailBody2 As String
Dim MailBody3 As String
Dim MailSubject As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim Attachment3 As String
Dim Attachment4 As String
Dim Attachment5 As String
Set rst = CurrentDb.OpenRecordset("tbl_email_distribution", dbOpenSnapshot)
With rst
Do Until .EOF
sendTo = !emailTo
If Not !emailTo Then
!emailTo = sendTo
Else
sendTo = ""
End If
CopyTo = !emailCC
If Not !emailCC Then
!emailCC = CopyTo
Else
CopyTo = ""
End If
If sendTo = "" And CopyTo = "" Then
MsgBox "Email Sent"
Exit Function
End If
DoCmd.OpenForm "email_body"
''MailBody = Forms!email_body!email_body.Caption
MailBody2 = Forms!email_body!email_body2.Caption
MailBody = Forms!email_distribution!emailBody
MailBody3 = Forms!email_body!email_body3.Caption
MailSubject = !emailSubject
Attachment1 = !AttachmentPath1
Attachment2 = !AttachmentPath2
Attachment3 = !AttachmentPath3
Attachment4 = !AttachmentPath4
Attachment5 = !AttachmentPath5
SendStatus = !send
'-------------------------------------------------------
If SendStatus = True Then
Set objMailDocument = objMailDb.CREATEDOCUMENT
objMailDocument.Form = "Memo"
objMailDocument.principal = "FP&A Central Support/FluorCorp"
objMailDocument.sendTo = Split(sendTo, ",")
objMailDocument.CopyTo = Split(CopyTo, ",")
objMailDocument.subject = MailSubject
objMailDocument.Body = MailBody2 & MailBody & MailBody3
objMailDocument.SAVEMESSAGEONSEND = True
'Set up the embedded object and strFileAttachment and attach it
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment1")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
objMailDocument.CREATERICHTEXTITEM ("Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment2")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment2, "Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment3")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment3, "Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment4")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment4, "Attachment")
End If
If Attachment <> "" Then
Set objAttachment = objMailDocument.CREATERICHTEXTITEM("Attachment5")
Set objEmbedObject = objAttachment.EMBEDOBJECT(1454, "", Attachment5, "Attachment")
End If
'Send the document
objMailDocument.PostedDate = Now()
objMailDocument.send 0, Split(sendTo, ",")
'objMailDocument.send 0, Split(CopyTo, ",")
'objMailDocument.Save True, True, False
'CreateObject("Notes.NotesUIWorkspace").EDITDOCUMENT True, objMailDocument
'objMailDocument "> " & Subject
End If
'-------------------------------------------------------
DoCmd.close acForm, "email_body"
.MoveNext
Loop
.close
End With
'Clean Up
Set rst = Nothing
Set objMailDb = Nothing
Set objMailDocument = Nothing
Set objAttachment = Nothing
Set objNotesSession = Nothing
Set objEmbedObject = Nothing
Set Body = Nothing
Set Body2 = Nothing
Set Body3 = Nothing
MsgBox "Email Sent"
End Function