Error sending HTML mails with Agents in LotusScript - lotus-notes

I am trying to send emails from agents, but i have an error always with the next document that the agent process.
For example, if there are 5 emails to send, the first is ok, but with the second the agent stops and show this error:
Objet variable not set
The code:
Sub Initialize
Dim ws As New NotesUIWorkspace
Dim ns As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim body As NotesMIMEEntity
Dim maildoc As NotesDocument
Dim mh As NotesMIMEHeader
Dim stream As NotesStream
Dim formula As String
Dim header As String
Dim body2 As String
Set db = ns.CurrentDatabase
Set maildoc = db.Createdocument
'Set doc = ws.Currentdocument.Document
Set stream = ns.Createstream()
header = "Test Agent"
body2 = "Test Agent"
' Create the MIME headers
Set body = maildoc.CreateMIMEEntity
Set mh = body.CreateHeader("Subject")
' Dont convert text to rich text
ns.Convertmime = False
' Configure the mail
maildoc.Form = "Memo"
maildoc.Subject = "Test Agent"
maildoc.SendTo = "Email Destination"
maildoc.CopyTo = ""
maildoc.blindCopyTo = ""
Dim dateObj As New NotesDateTime("")
'#Adjust( fecha-hora ; años ; meses ; días ; horas ; minutos ; segundos ; [ DST ] )
formula = "(Form = ""frm-testdevelop-solicitud"") & (Estado = ""Borrador"")"
Set docs = db.Search(formula, Nothing, 0)
If docs.count > 0 Then
Print "hay " + Cstr(docs.count) + " docs"
Set doc = docs.GetFirstDocument
While Not doc Is Nothing
Call stream.Writetext(|<html lang="es">|)
Call stream.Writetext(|<head>|)
Call stream.Writetext(|<meta name="viewport" content="width=device-width, initial-scale=1.0">|)
Call stream.Writetext(|<meta http-equiv="X-UA-Compatible" content="ie=edge">|)
Call stream.Writetext(|</head>|)
Call stream.Writetext(|<body>|)
Call stream.Writetext(|<div style="background-color: #897d7d; border-radius: 0.5em; width: auto; height: 50px;">
<h1 style="color: white; text-align: center; padding: 0.1em;
font-family: Cambria, Cochin, Georgia, Times, 'Times New Roman', serif;">| & header & |</h1>
</div>|)
Call stream.Writetext(|<p>| & body2 & |</p>|)
Call stream.Writetext(|</body>|)
Call stream.Writetext(|</html>|)
Call body.SetContentFromText(stream, {text/html;charset="utf-8"}, ENC_NONE)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Here is the error in the second iterate.
' Close the stream
Call stream.Close()
' Restore conversion
ns.Convertmime = True
' Send it
Call maildoc.Send(False)
' Next document
Set doc = docs.GetNextDocument(doc)
Wend
Else
Print "No hay documentos"
End If
Exit Sub
In the second iterate the agent stop in this part of the code:
Call body.SetContentFromText(stream, {text/html;charset="utf-8"}, ENC_NONE)
I know that the error is because I am sending this email with HTML format, because if I remove the sendemail block of code, the agents runs fine.
And I have no idea what I am doing wrong, any suggest?
Thanks a lot!

On every run you add the new content to the stream. As you do not "Open" a file with your stream, the "close" in your code does not do anything.
Replace the "stream.close" with a "stream.truncate" to remove the contents. That should do the trick.

Related

Lotusscript: Retrieve the images in the body of an email

In my agent, I try to retrieve all the files that are in the current email. My attached code works fine, except for the images in the body of the email. I manage to retrieve all the files and images that were attached to the email except the pictures that were copied and pasted in the middle of the email text. Here is my code:
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim item As Variant
Dim CurrentDocColl As NotesDocumentCollection
Set db = Session.Currentdatabase
Set CurrentDocColl = db.Unprocesseddocuments
Set doc = CurrentDocColl.Getfirstdocument
While Not doc Is Nothing
Set item = doc.GETFIRSTITEM("Body")
If doc.HasEmbedded Then
ForAll attachment In item.EmbeddedObjects
Call attachment.ExtractFile (pathname & "\" & attachment.Name)
End ForAll
End If
Set doc=CurrentDocColl.Getnextdocument(doc)
Wend
How can I retrieve these images?
Thank you very much for your help
I have an agent that does a lot of that, but it's not short. What you have to do is run the document through an XML DomParser, walk down the DOM tree and when you find a node with "JPEG" or "PNG" in the name (the inline images themselves), stream the data to a file and save it. The code is combination of an agent I found online (which I couldn't find again, otherwise I would give credit) and work I've done. You won't be able to copy/paste this sample code and expect it to work, I've removed things (like declaring variables and supporting functions) for brevity.
Sub Initialize
Dim dxlExp As NotesDXLExporter
Set dxlExp = s.CreateDXLExporter
Call dxlExp.setInput(Doc)
Set DomParser=s.CreateDOMparser()
Call DomParser.Setinput(dxlExp)
Dim dxlImp As NotesDXLImporter
Set dxlImp = s.Createdxlimporter()
Call dxlImp.Setinput(domParser)
Call dxlImp.SetOutput(db)
On Event PostDomParse From DomParser Call DomInputProcessed
Call dxlExp.Process
End Sub
Sub DomInputProcessed(DomParser As NotesDomParser)
Dim DomNode As NotesDomNode
Set DomNode = DomParser.Document
Call walkTree(DomParser, DomNode)
Exit Sub
End Sub
Sub walkTree (DomParser As NotesDOMParser, node As NotesDOMNode)
Select Case node.NodeType
Case DOMNODETYPE_DOCUMENT_NODE: ' If it is a Document node
domParser.Output( "<?xml version='1.0' encoding='utf-8'?>"+LF )
Set child = node.FirstChild ' Get the first node
Dim numChildNodes As Integer
numChildNodes = node.NumberOfChildNodes
While numChildNodes > 0
Set child = child.NextSibling ' Get next node
numChildNodes = numChildNodes - 1
Call walkTree(DOMParser, child)
Wend
Case DOMNODETYPE_DOCUMENTTYPE_NODE: ' It is a <!DOCTYPE> tag
domParser.Output("<!DOCTYPE "+ node.NodeName+ ">" + LF)
Case DOMNODETYPE_TEXT_NODE: ' Plain text node
value = xmlReplace(node.NodeValue)
domParser.Output(value)
Case DOMNODETYPE_ELEMENT_NODE: ' Most nodes are Elements
Select Case node.NodeName
Case "jpeg"
Dim jpegfile As String
' Step 1, write the MIME file
Dim base64node As NotesDOMNode
Set base64Node = node.Firstchild
Dim base64Out As NotesStream
Set base64Out = s.createStream()
Dim bytesWritten As Long
bytesWritten = base64Out.Writetext(base64Node.NodeValue)
' Step 2, Read the MIME file and decode it.
Set db=s.currentdatabase
Set doc=db.createDocument()
Set m=doc.Createmimeentity("Image1")
Call m.setContentFromText(base64Out, "image/jpeg", 1727)
Call m.Decodecontent()
Dim JPEGOut As NotesStream
Set JPEGOut = s.createStream()
jpegFile = RandomFileName(baseDir, ".jpg")
JPEGOut.open(jpegFile)
Call m.Getcontentasbytes(JPEGOut, True)
Call JPEGOut.Close()
attachmentNamesStr = attachmentNamesStr + jpegFile + "~"
' Step 3, remove the jpeg and its child node
' We do this by just not sending anything to the DomParser output.
Case "png"
' Same as JPEG except it's PNG.
End Select
End Select 'node.NodeType
End If 'Not node.IsNull
End Sub

Error Sending automation mail after registration using lotus script

Question:
1. My question why after registration of an user still not listed in domino directory?
Case:
I am using xPages form call lotus script agent.
All my script is using lotus script to register an user.
After Complete register an email, need to send automation notification mail to user as welcome mail.
when i complete registration, i want to send mail, it give me an error message:
1.unable to deliver message 'ChunWH#devsvr1.pcs.com.my'
2.User 'ChunWH#devsvr1.pcs.com.my' not listed in Domino Directory
Register user Agent
Option Public
Option Declare
Sub Initialize
On Error GoTo ErrorHandler
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailfile As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0)
certpasswd = depdoc.IdPassword(0)
OU = ""
lastname= doc.Name(0)
firstname = ""
middleinit = ""
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id"
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0)
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr
reg.CreateMailDb = True '
reg.CertifierIDFile = certid
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1
reg.IsNorthAmerican = True
reg.OrgUnit = OU
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = false
reg.MailInternetAddress = internetpath
reg.Shortname=doc.SelectMail(0)
reg.Mailowneraccess =2
reg.Mailcreateftindex=True
reg.Mailaclmanager ="LocalDomainAdmins"
reg.Grouplist=groups
Call reg.RegisterNewUser(lastname, _
usridpath, _
mailsvr, _
firstname, _
middleInit, _
certpasswd, _
"", _
"", _
mailfile, _
"", _
userpasswd, _
NOTES_DESKTOP_CLIENT)
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End if
' call name nsf and open for edit for forcing user must change password first time
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True )
Print "Please wait ...... Registration in progress"
Call doc.Replaceitemvalue("S_Process", "Pending")
Call doc.Save(True, False)
Dim agt As NotesAgent
Set agt=db.getagent("(Welcome Mail)")
Call agt.Runonserver()
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
Function remapChr (oldString)
' to replace all special character with a empty space after that trim to remove all special character in system
Dim oldChr, newChr, newString As String
oldChr = {! "" # $ % & ' ( ) * + , - . / : ; = > ? # [ \ ] ^ _}
newChr = " {"
oldChr = Split(oldChr, " ")
newChr = Split(newChr, " ")
newString = Trim(Replace(LCase(oldString), oldChr, newChr))
remapChr = newString
End Function
Function group(groupArr, newReason$)
If IsArray(groupArr) Then
If groupArr(0) = "" Then
groupArr(0) = newReason
Else
Dim counter%
counter = UBound(groupArr) + 1
ReDim Preserve groupArr(counter)
groupArr(counter) = newReason
End If
group = groupArr
Else
Dim tempgroupArr() As String
ReDim tempgroupArr(0)
tempgroupArr(0) = newReason
group = tempgroupArr
End If
End Function
Sending mail Agent
Sub Initialize
On Error GoTo ErrorHandler
Print "Welcome Mail Agent started..."
' This agent is a sub agent for register user, which let register agent call
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim receiver$
Dim tmpallve As NotesViewEntry
Dim viwUser As NotesView
Dim viwVe As NotesViewEntry
Dim viwVc As NotesViewEntryCollection
Dim docUser As NotesDocument
Set viwUser = db.GetView("(Request sort by S_Process)")
'Set docUser = viwUser.GetDocumentByKey("Pending",True)
Set viwVc = viwUser.Allentries
If viwVc.Count = 0 Then
Print "No item found in this list"
Exit Sub
End If
Set viwVe = viwVc.Getfirstentry()
Do While Not viwVe Is Nothing ' loop to all entry
Set docUser = viwVe.Document
receiver$ = docUser.SelectMail(0) + "#devsvr1.pcs.com.my"
' send mail
Set maildoc = db.Createdocument()
Call maildoc.Replaceitemvalue("Form", "Memo")
Call maildoc.Replaceitemvalue("Subject", "Welcome")
Call maildoc.Replaceitemvalue("SendTo", receiver)
Set body = maildoc.Createmimeentity
s.Convertmime = False
Set stream = s.Createstream()
stream.Writetext(|<html><body>|)
stream.Writetext(|<p>Your application for registration ....</p>|)
stream.Writetext(|<p>Welcome. Pleaase....</p>|)
stream.Writetext(|<p><em>(No signature requried on this computer generated document)</em></p>|)
stream.Writetext(|<p>*** This is a system generated email. | + _
|Please do not reply to this email. ***</p>|)
Call stream.Writetext(|</body></html>|)
Call body.Setcontentfromtext(stream, "text/html;charset=UTF-8", 1725)
Call maildoc.Send(False)
s.Convertmime = True
Call docUser.Replaceitemvalue("S_Process", "Processed")
Call docUser.Save(True, False)
Set tmpallve = viwVc.Getnextentry(viwVe)
Set viwVe = tmpallve
Loop
Print "Welcome Mail Agent finished..."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
new update of image on 25/09/2017
(after set config router_debug=3 set config DebugRouterLookup=3 )
i try send manually will be fine...but using code directly send after registration will be fail. Not only that, i also try on sleep(2) , wait 2 second just send mail..it seem like my thought of not directly create mail account mail also not valid..not sure which part is wrong?
I suspect that your issue is one of time and caching. The Domino server maintains a Name Lookup Cache that only gets refreshed, well, occasionally (I have never figured out how occasionally that is but 5-10 minutes generally does the trick). This affects both the email functions and the web login functions. What I have done with my registration systems is have the agent that does the ID creation leave a document in it database that is in the status "Pending welcome email". Then another agent finds those docs and if they are more then 15 minutes old it attempts the email. if the email goes through then the status is changed to "Complete".
Note, you can reset the cache with the console command show nlcache reset and that almost always results in the user being able to get mail and login from a browser. But I have not been able to get that to work from a scheduled agent run on the server or a web agent.
Can you take a look at the Person Document? See if that address is properly registered on the document.
You may also try to enable router_debug=3 and DebugRouterLookUp=3 and we may see where did it try to lookup the address.

Get Element By ? tag name id or class name How do you get the innertext of below

The UPS Website changed. Instead of the tag it change to
Private Function TrackUPS(trackingNumber As String) As String
Dim xml As Object
Dim tempString As String
Dim htmlDoc As Object ' MSHTML.HTMLDocument
Dim htmlBody As Object ' MSHTML.htmlBody
Dim anchors As Object ' MSHTML.IHTMLElementCollection
Dim anchor As Object ' MSHTML.IHTMLElement
Dim dds As Object ' MSHTML.IHTMLElementCollection
Dim ddr As Object
Dim dt As Object
Dim dd As Object ' MSHTML.IHTMLElement
'tempString = GetMSXMLWebResponse(UPSUrl & trackingNumber)
Set xml = GetMSXML
If xml Is Nothing Then ' cannot start MSXML 6.0
TrackUPS = MSXML_ERROR
Exit Function
End If
tempString = GetResponse(xml, HTTP_GET, UPSUrl & trackingNumber, False)
If Len(tempString) = 0 Then
TrackUPS = ERROR_MSG
Exit Function
End If
Set htmlDoc = CreateHTMLDoc
If htmlDoc Is Nothing Then ' cannot reference MSHTML object library
TrackUPS = MSHTML_ERROR
Exit Function
End If
Set htmlBody = htmlDoc.body
htmlBody.innerHTML = tempString
On Error Resume Next
Set dds = htmlDoc.getElementsByclassname("").innerText
'Set dds = htmlDoc.getElementsByTagName("dd")
Set ddr = htmlDoc.getElementsByTagName("dt")
Strg1 = htmlDoc.getElementById("tt_spStatus").innerText
Strg2 = dds.Item(1).innerText
Strg3 = dds.Item(11).innerText
Strg4 = htmlDoc.getElementById("tt_pgfStatus").innerText
Strg5 = htmlDoc.getElementById("tt_ovntStatus").innerText
If Len(Strg1) = 0 Then
Strg1 = Strg4
If Len(Strg4) = 0 Then
Strg1 = Strg5
End If
End If
PODEnd10 = Strg1 & "|" & Strg2
If PODEnd10 = "|1. " Then GoTo Line1 Else GoTo Line2
Line2:
If PODEnd10 = "|>>>1." Then GoTo Line1 Else GoTo Line3
Line3:
TrackUPS = Strg1 & "|" & Strg2
Exit Function
Line1:
TrackUPS = "NO|POD|INFO"
Exit Function
End Function
So the website shows the Day and Time with this:
<p class="">
Monday, 01/11/2016
at 9:09 A.M.
</p>
I use this in the above code:
Set dds = htmlDoc.getElementsByclassname("").innerText
However the <p class=""> has no name. How do I capture the innertext of that element?
Any help would be greatly appreciated. I rely on this daily.
Here is the entire div class:
<div class="ups-group ups-group_condensed">
p class="ups-form_label"><strong>Delivered On:</strong></p>
<p class="">
Monday, 01/11/2016
at 9:09 A.M.
</p>
</div>
What would be the .innertext coding in vba to return the Monday and the date and time of the P class""?
This worked:
Set dds = htmlDoc.getElementsByTagName("p")
Strg2 = dds.Item(11).innerText

Remainder Mail agent

I have form with 3 fields adress,status,ReportingDate.
Adress field contains the ID where the mil has to be sent.
Now I have created an agent where it should mail to the data present in adress field when status is incomplete and reporting date is exactly 7 days before todays date.
My Code:
Option Public
Option Declare
Sub Initialize
Dim sess As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim timestamp As New NotesDateTime("Today")
Dim Noresponsedate As NotesDateTime
Dim vw As NotesView
Dim diff As Integer
Dim SendTo As Variant
Call timestamp.SetNow()
Set db = sess.CurrentDatabase
Set vw = db.GetView( "data" )
Set doc = vw.GetFirstDocument()
While Not doc Is Nothing
If doc.Status(0) = "Incomplete" Then
Call checktimedifference(doc)
End if
Set doc = vw.GetNextDocument(doc)
wend
End Sub
Sub checktimedifference(doc As NotesDocument)
Dim due As NotesDateTime
Dim present As NotesDateTime
Dim timecheck As variant
Set due = New NotesDateTime ( "" )
Set present = New NotesDateTime ( "Today" )
timecheck = doc.ReportingDate(0)
due.LSLocalTime = timecheck
If due.TimeDifference (present) = -604800 Then
Call sendmailtouser(doc)
End If
End Sub
Sub sendmailtouser(doc As NotesDocument)
Dim db As NotesDatabase
Dim rtiitem As NotesRichTextItem
Dim maildoc As NotesDocument
dim recepient As variant
Set maildoc = New NotesDocument( db )
Set rtiitem = New NotesRichTextItem( maildoc, "Body" )
recepient = doc.adress(0)
maildoc.from = db.Title
maildoc.form = "memo"
maildoc.subject = "A Minor Injury Report:" & doc.Seq_No(0) & " needs your response"
maildoc.SendTo = recepient
Call rtiitem.AppendText( "Please respond to this Minor Injury Report" )
Call rtiitem.AddNewline( 2 )
Call rtiitem.AppendText( "Your response for the Minor Injury Report: " & doc.Seq_No(0) & " is required" )
Call rtiitem.AddNewline( 2 )
Call rtiitem.AppendText( "Please click on the following link to access the document.")
Call rtiitem.AppendDocLink( doc, db.Title )
Call maildoc.Send(False)
End Sub
When I am running the agent on client I am getting the following error:
Please help me to solve the error and send mail to the recepients.
Not using any error handling is very bad practice. But your error will most probably happen in the sendmailtouser- sub, where you dim a local notesdatabase- object named db without actually initializing it.
The line
set maildoc = New NotesDocument( db )
will fail.
Either declare db globally and set it in your initialize or dim ses in that sub again and set db again (worst case as you have to do it for every document)

LotusScript cannot get file attachment from email

I had never run into this problem, but I cannot get a handle on a file attachment on an email. I have code that can either search the document for Embedded Objects or search a field for Embedded Objects -- neither of them are returning the file. I can see the file on the email and I can see the $FILE field which contains the file attachment.
Here is the code:
Function FileDetachFiles(doc As NotesDocument, fieldName As String, getFromField As Integer) As Variant
On Error Goto ProcessError
Dim s As NotesSession
Dim db As NotesDatabase
Dim rtItem As NotesRichTextItem
Dim fileToExtract As String
Dim fileName As String
Dim fileArray() As String
Dim message As String
Dim embedObjects As Variant
Dim attachFile As Integer
Dim x As Integer
Set s = New NotesSession
Set db = s.CurrentDatabase
Const fileImport = "C:\"
attachFile = False
'Let's see if there are attached files...
If getFromField = True Then
'Locate field and get files...
If doc.HasEmbedded Then
If doc.HasItem(fieldName) Then
'Set the first field...
Set rtItem = doc.GetFirstItem(fieldName)
embedObjects = rtItem.EmbeddedObjects
If Isarray(embedObjects) Then
Forall Files In rtItem.EmbeddedObjects
If Files.Type = EMBED_ATTACHMENT Then
fileName = Files.Source
fileToExtract = fileImport & fileName
Redim Preserve fileArray(x)
fileArray(x) = fileToExtract
x = x + 1
Call Files.ExtractFile(fileToExtract)
attachFile = True
End If
End Forall
End If
End If
End If
Else
x = 0
'Go through doc looking for all embedded objects...
If doc.HasEmbedded Then
Forall o In doc.EmbeddedObjects
If o.Type = EMBED_ATTACHMENT Then
fileName = o.Name
fileToExtract = fileImport & fileName
Call o.ExtractFile(fileToExtract)
Redim Preserve fileArray(x)
fileArray(x) = fileToExtract
x = x + 1
attachFile = True
End If
End Forall
End If
End If
If attachFile = True Then
FileDetachFiles = fileArray
End If
Exit Function
ProcessError:
message = "Error (" & Cstr(Err) & "): " & Error$ & " on line " & Cstr(Erl) & " in GlobalUtilities: " & Lsi_info(2) & "."
Messagebox message, 16, "Error In Processing..."
Exit Function
End Function
I tried both routines above -- passing the $FILE and Body field names, as well as searching the document. It does not find any file attachments.
I even tried this:
Extracting attachments as MIME using LotusScript
Which did not find any MIME on the document.
I have never run into this problems -- any ideas would be great.
Thanks!
I had that before, but unfortunately do not remember, where it comes from, it might have to do something with V2- Style Attachments coming from Domino Websites...
Try Evaluate( #AttachmentNames ) to get a Variant containing the names of all attachments. Then loop through this with a Forall- loop and try the NotesDocument.getAttachment( strLoopValue ) - Function to get a handle to the attachment.
For further info read here and follow the links on that page, especially this one
Code would be something like this:
Dim doc as NotesDocument
Dim varAttachmentNamens as Variant
Dim object as NotesEmbeddedObject
REM "Get the document here"
varAttachmentNames = Evaluate( "#AttachmentNames" , doc )
Forall strAttachmentName in varAttachmentNames
Set object = doc.GetAttachment( strAttachmentName )
REM "Do whatever you want..."
End Forall

Resources