Error 3000 Using VBA and HCL ( Lotus) notes

89 Views Asked by At

I made a code to send some emails, using HCL NOTES and Excel, but I have been stuck. ERROR 3000 appears when going through the line ".SEND 0, vaRecipient". I think what happens is that the connection with the database is lost, after going through the procedure of attaching an image to the body of the mail. Since if I remove those lines of code, no error arises.

Sub SendQuoteToEmail()
Dim NSession As Object
Dim NDatabase As Object
Dim NUIWorkSpace As Object
Dim NDoc As Object
Dim NUIdoc As Object
Dim NRichTextItem As Object
Dim NrichTextHeader As Object
Dim NMimeImage As Object
Dim strImageType As String
Dim WordApp As Object
Dim EmbedObj As Object
Dim Body As Object
Dim NStream As Object
Dim Subject As String
Dim MailAddress As String
Dim MailAddressCC As String
Dim MailAddressCC2 As String
Dim MailAddressCCO As String
Dim MailAddressCCO2 As String
Dim AttchFiles1, AttchFiles2, AttchFiles3, AttchFiles4 As String
Dim AddImage As String
Dim pf As Integer
Dim Uf As Integer
Dim x As Double
'On Error Resume Next

Set a = ThisWorkbook.Sheets("Base Emails")

pf = 4 
Uf = 0
Do While Uf = 0

cuit = Range("a" & pf).Value
    If cuit <> Empty Then
        Subject = UserForm1.SubjectBox & a.Cells(pf, "D") & " - CUIL N°: " & a.Cells(pf, "A") '
        MailAddress = a.Cells(pf, "F") 
        MailAddressCC = UserForm1.TextBoxCC
        MailAddressCC2 = UserForm1.TextBoxCC2
        MailAddressCCO = UserForm1.TextBoxCCO
        MailAddressCCO2 = UserForm1.TextBoxCCO2

        Set NSession = CreateObject("Notes.NotesSession")

        Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
        Set NDatabase = NSession.GETDATABASE("", "")

    If Not NDatabase.IsOpen Then NDatabase.OPENMAIL

        Set NDoc = NDatabase.CREATEDOCUMENT
        With NDoc
            .SendTo = MailAddress
            .CopyTo = MailAddressCC & ", " & MailAddressCC2
            .Subject = Subject
            .Body = UserForm1.FirstLineBox & vbLf & vbLf & _
                    UserForm1.FirstParagraphBox & vbLf & vbLf & _
                    UserForm1.SecondParagraphBox & vbLf & vbLf & _
                    UserForm1.ThirdParagraphBox & vbLf
            .SAVEMESSAGEONSEND = True

        End With

        AddImage = ThisWorkbook.Path & "\Image\" & Worksheets("Files").Range("A" & 5)
            If AddImage <> "" Then
                Set NStream = NSession.CREATESTREAM
                Call NStream.Open(AddImage)
                Set Body = NDoc.CreateMIMEEntity("memo")
                Set richTextHeader = Body.CreateHeader("Content-Type")
                Call richTextHeader.SetHeaderVal("multipart/mixed")
                Set mimeImage = Body.CreateChildEntity()
                strImageType = "image/jpeg; image/gif" '" Other formats are "image/gif" "image/bmp" - 
                Call mimeImage.SetContentFromBytes(NStream, strImageType, ENC_IDENTITY_BINARY)
                Call NStream.Close
            End If

        
        AttchFiles1 = ThisWorkbook.Path & "\Files\" & Worksheets("Files").Range("A" & 1)
            If AttchFiles1 <> "" Then
                Set AttachMe = NDoc.CREATERICHTEXTITEM("Attachment1")
                Set EmbedObj = AttachMe.EmbedObject(1454, "", AttchFiles1, "Adjunto")
            End If

        AttchFiles2 = ThisWorkbook.Path & "\Files\" & Worksheets("Files").Range("A" & 2)
            If AttchFiles2 <> "" Then
                Set AttachMe = NDoc.CREATERICHTEXTITEM("Attachment2")
                Set EmbedObj = AttachMe.EmbedObject(1454, "", AttchFiles2, "Adjunto")
            End If

        AttchFiles3 = ThisWorkbook.Path & "\Files\" & Worksheets("Files").Range("A" & 3)
            If AttchFiles3 <> "" Then
                Set AttachMe = NDoc.CREATERICHTEXTITEM("Attachment3")
                Set EmbedObj = AttachMe.EmbedObject(1454, "", AttchFiles3, "Adjunto")
            End If

        AttchFiles4 = ThisWorkbook.Path & "\Files\" & Worksheets("Files").Range("A" & 4)
                If AttchFiles4 <> "" Then
                Set AttachMe = NDoc.CREATERICHTEXTITEM("Attachment4")
                Set EmbedObj = AttachMe.EmbedObject(1454, "", AttchFiles4, "Adjunto")
            End If

        With NDoc
        .PostedDate = Now()
        .SEND 0, vaRecipient  '<--- ERROR 3000

        End With
        Set NStream = Nothing
        Set NDoc = Nothing
        Set WordApp = Nothing
        Set NSession = Nothing
        Set EmbedObj = Nothing

        pf = pf + 1
        
    Else
        Uf = 1
        Exit Do
    End If
Loop
VbMessage = "Sent messages"
Call Clean
End Sub

If I remove these lines of code, the procedure works. So I suppose that by manipulating "NSession", something happens, but I don't know what.

AddImage = ThisWorkbook.Path & "\Image\" & Worksheets("Files").Range("A" & 5)
            If AddImage <> "" Then
                Set NStream = NSession.CREATESTREAM
                Call NStream.Open(AddImage)
                Set Body = NDoc.CreateMIMEEntity("memo")
                Set richTextHeader = Body.CreateHeader("Content-Type")
                Call richTextHeader.SetHeaderVal("multipart/mixed")
                Set mimeImage = Body.CreateChildEntity()
                strImageType = "image/jpeg; image/gif" '" Other formats are "image/gif" "image/bmp" - 
                Call mimeImage.SetContentFromBytes(NStream, strImageType, ENC_IDENTITY_BINARY)
                Call NStream.Close
            End If
1

There are 1 best solutions below

0
Richard Schwartz On

You've got two pieces of incompatible code here.

            .Body = UserForm1.FirstLineBox & vbLf & vbLf & _
                UserForm1.FirstParagraphBox & vbLf & vbLf & _
                UserForm1.SecondParagraphBox & vbLf & vbLf & _
                UserForm1.ThirdParagraphBox & vbLf

And

            Set Body = NDoc.CreateMIMEEntity("memo")
            Set richTextHeader = Body.CreateHeader("Content-Type")
            Call richTextHeader.SetHeaderVal("multipart/mixed")
            Set mimeImage = Body.CreateChildEntity()
            strImageType = "image/jpeg; image/gif" '" Other formats are "image/gif" "image/bmp" - 
            Call mimeImage.SetContentFromBytes(NStream, strImageType, ENC_IDENTITY_BINARY)

You can't work with the message body both as Notes rich text (the first piece of code) and as MIME. You need to pick one or the other. I'm guessing you're going to pick MIME, in which case you are going to need to create a text/plain part and populate it with your three paragraphs of text.