To extract an attachment from the rich text field

HCL Domino Domino Forum
1

I have the following code which works in the agent for the rich text field but does not work when i implement the same code on the button of the form. Can anybody help me to modify the code so that it works on a button on the form.

On Error Goto errhandler

Dim ws As New NotesUIWorkspace

Dim db As NotesDatabase

Dim uid As NotesUIDocument

Dim doc As NotesDocument

Dim MailDoc As NotesDocument



Set db = ws.CurrentDatabase.Database

Set uid = ws.CurrentDocument

Set doc = uid.Document

Call uid.Refresh

Set MailDoc = db.CreateDocument

MailDoc.Form = "Memo"

Dim recipients() As String

Dim cnt As Integer

cnt = 1



'Code modified by Sameer Damania on 7th May 2009

If Trim(doc.MType(0))="Ma" Then

	Forall x In doc.SupportSite

		Redim Preserve recipients(cnt) As String

		recipients(cnt) = x

		cnt = cnt + 1

	End Forall

Else

	Forall y In doc.SiteSupport

		Redim Preserve recipients(cnt) As String

		recipients(cnt) = y

		cnt = cnt + 1

	End Forall

End If

'End of Code modified by Sameer Damania

Dim Item As NotesItem

Set Item = doc.GetFirstItem("Comments")

MailDoc.Subject = Item.Text + " - " + doc.RequestType(0) + " - " + doc.FirstName(0) + " " + doc.LastName(0) + " - <ID Completed>"

Dim MailBody As NotesRichTextItem

Set MailBody = New NotesRichTextItem(MailDoc, "Body")	

Call MailBody.AppendText("Hi,")

Call MailBody.AddNewLine(2)

Dim IDFile As NotesRichTextItem

Set IDFile = doc.GetFirstItem("IDFile")----> gives me an error on this line that is object variable not set.

Call MailBody.AppendText("New notes ID file for --> " + doc.FirstName(0) + " " + doc.LastName(0) + " --> ")

Dim object As NotesEmbeddedObject

Dim folderName As String

Forall o In IDFile.EmbeddedObjects

	folderName = "c:\NotesIDFiles"

	If Not (isFolder(folderName)) Then

		Mkdir(folderName)

	End If 

	Call o.ExtractFile( folderName + "\" + o.Source )

	Call MailBody.EmbedObject(o.Type,"",folderName + "\" + o.Source)

	Kill(foldername + "\" + o.Source)

End Forall	

Rmdir(folderName)

Call MailBody.AddNewLine(2)

Call MailBody.AppendText( "Requested By --> " + doc.RequestedBy(0))

Call MailBody.AddNewLine(2)

Call MailBody.AppendText( "Thanks & Regards," )

Call MailBody.AddNewLine(1)

strconst = {@Name([CN];@UserName)}	

eval = Evaluate(strconst)

Call MailBody.AppendText(eval(0))

Call MailBody.AddNewline(1)

Call MailBody.AppendText("GSA_GlobalSecurityAdmins.")

Call MailDoc.ReplaceItemValue("Principal","GSAGlobalSecurityAdmins") ' Added by Sameer Damania to incorporate the sending of id file and password from your own login

MailDoc.BlindCopyTo = "GlobalSecurity_Admins@colpal.com"

If Trim(doc.SupportSite(0)) = "Asia Pacific Helpdesk/AULSY/AP/COLPAL" Or Trim(doc.SupportSite(0))="Malaysia Helpdesk/MALKL/AP/COLPAL" Or Trim(doc.SiteSupport(0)) = "Asia Pacific Helpdesk/AULSY/AP/COLPAL" Or Trim(doc.SiteSupport(0)) = "Malaysia Helpdesk/MALKL/AP/COLPAL"Then

	MailDoc.EncryptOnSend = False

Else

	MailDoc.EncryptOnSend = True

End If

Call uid.Save

Call MailDoc.Send(False,recipients)

Set MailDoc = db.CreateDocument

MailDoc.Form = "Memo"

MailDoc.Subject = Item.Text + " - " + doc.RequestType(0) + " - " + doc.FirstName(0) + " " + doc.LastName(0) + " - <Password Completed>"

Set MailBody = New NotesRichTextItem(MailDoc, "Body")	

Call MailBody.AppendText("Hi,")

Call MailBody.AddNewLine(2)

Call MailBody.AppendText("The password for the user --> " + doc.FirstName(0) + " " + doc.LastName(0) + " --> " + doc.IDPassword(0))

Call MailBody.AddNewLine(2)

Call MailBody.AppendText( "Requested By --> " + doc.RequestedBy(0))

Call MailBody.AddNewLine(2)

Call MailBody.AppendText( "Thanks & Regards," )

Call MailBody.AddNewLine(1)

strconst = {@Name([CN];@UserName)}

eval = Evaluate(strconst)

Call MailBody.AppendText(eval(0))

Call MailBody.AddNewline(1)

Call MailBody.AppendText("GSA_GlobalSecurityAdmins.")

Call MailDoc.ReplaceItemValue("Principal","GSAGlobalSecurityAdmins") ' Added by Sameer Damania to incorporate the sending of id file and password from your own login

MailDoc.BlindCopyTo = "GlobalSecurity_Admins@colpal.com"

If Trim(doc.SupportSite(0)) = "Asia Pacific Helpdesk/AULSY/AP/COLPAL" Or Trim(doc.SupportSite(0))="Malaysia Helpdesk/MALKL/AP/COLPAL" Or Trim(doc.SiteSupport(0)) = "Asia Pacific Helpdesk/AULSY/AP/COLPAL" Or Trim(doc.SiteSupport(0)) = "Malaysia Helpdesk/MALKL/AP/COLPAL"Then

	MailDoc.EncryptOnSend = False

Else

	MailDoc.EncryptOnSend = True

End If

Call MailDoc.Send(False, recipients)

Msgbox "Mail Sent"

Exit Sub

errhandler:

Msgbox "Error " + Error + " : Error line " + Cstr(Erl)

Exit Sub

End Sub

2

Subject: To extract an attachment from the rich text field

maybe this will help…

this code checks to see if there is an attachment

you can add code to delete it.

Dim s As New NotesSession

Dim w As New NotesUIWorkspace

Dim db As NotesDatabase

Dim uidoc As NotesUIDocument

Dim doc As NotesDocument

Dim item As notesitem

Dim rtf As Variant



Set db = s.CurrentDatabase	

Set uidoc = w.CurrentDocument

Set doc = uidoc.Document



Set doc = uidoc.Document

Call uidoc.Refresh(True) 



Set item=doc.GetFirstItem("w9")

If item.Values(0) = "Yes" Then

	Set rtitem=doc.GetFirstItem("body")

	If Not rtitem Is Nothing Then

		If Isempty(rtItem.EmbeddedObjects) Then

			Msgbox "Plz attach a file"

			Call uidoc.GotoField( "body" )

			Continue = False

			Exit Sub

		End If

	End If

End If