In a LotusScript driven application we make heavy use of NotesDirectory.LookupNames to create DirNavs and retrieve data from person documents. Works fine just using the server's primary NAB: we're using ($Users) view for the lookup then return values from the matching person documents' fields.
Now we have to extend this so that we also are able to lookup people stored in a secondary NAB. This secondary NAB is replicated to the server where the application is running, and Directory Assistance is set up. AFAIK DA is basically working (e.g. the secondary NAB can be selected from in standard names dialogs), and the secondary NAB appears to be a full directory; at least database properties say that it's a "Domino Directory" type of DB.
Problem is: using NotesDirectory.LookupNames does not yield any results if we're looking for names stored in the secondary NAB, while looking for names stored in the primary one still works
Server this runs on is V 11.0.1; all NABs and da.nsf are running more or the latest design (ran design refreshes from templates located on a V 10.0.1 server)
Main question is: is this supposed to work in the first place?
Documentation for the class just speaks of "the directories", so I assume that this should be possible.
Any hint is very welcome
-- UPDATE 2021-02-24 --
for completeness here's the (corrected) test agent's code as suggested by Scott: user #1 is from the primary directory while #2 is from the secondary one
Sub Initialize
Dim sn As New NotesSession
Dim nDir As NotesDirectory
Dim nDirNav As NotesDirectoryNavigator
Dim sKey As String, sVw As String, sSrv As String
Dim vItems As Variant, vItem As Variant, vResult As Variant, vKeys As Variant
Dim i As Integer
sVw = "($Users)"
sSrv = "devtest/edcomTest"
Set nDir = sn.Getdirectory(sSrv)
nDir.Searchalldirectories = True 'Not really necessary, but doesn't hurt either
ReDim vKeys(1)
vKeys(0) = "sautor1"
vKeys(1) = "Veronika.Test#edcomtest.de"
ReDim vItems(2)
vItems(0) = "Type"
vItems(1) = "FullName"
vItems(2) = "ShortName"
ReDim vResult(0)
Set nDirNav = nDir.Lookupnames(sVw, vKeys, vItems, False)
Do While nDirNav.Namelocated
Do While nDirNav.Matchlocated
vItem = nDirNav.Getfirstitemvalue()
vResult(0) = vItem(0)
'Looping the other items
For i=1 To 2
vItem = nDirNav.Getnextitemvalue()
vResult = ArrayAppend(vResult, vItem(0))
Next
Call nDirNav.Findnextmatch()
Loop
Call nDirNav.Findnextname()
Loop
Print Join(vResult, "; ")
End Sub
I'm highly embarrassed as the cause for this "failure" was a simple typo in a user's name, where I simply had mispelled "Veronika" as "Veronica"...
(It's already corrected in the code snippet above)
Related
Excel crashes, VBA raises Error 3218 “Could Not Update” Record Locking Errors when multiple users try to update same table in a shared MS-Access database using DAO.
I have a special configuration like this: a MS-Access database located in shared network folder, multiple user connect to update that database using VBA DAO build on Excel file. The VBA code in each Excel file is the same. The problem happens when there are 2 users click on update button at the same time. User Excel file turn hanging, or showing error 3218 "Could not update".
Sub ExportToAccess()
Dim oSelect As Range, i As Long, j As Integer, sPath As String
'tblSuppliers.Active
Set oSelect = Application.InputBox("Range", , Range("A1").CurrentRegion.Address, , , , , 8)
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
sPath = "\\sharedfolder\Database.accdb"
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath)
Set oRS = oDB.OpenRecordset("tblSuppliers")
For i = 2 To oSelect.Rows.Count 'skip label row
oRS.AddNew
For j = 1 To oSelect.Columns.Count 'Field(0) is Auto#
oRS.Fields(j) = oSelect.Cells(i, j)
Next j
oRS.Update
Next i
oDB.Close
MsgBox ("Updated Done!")
End Sub
I know my configuration is not good for database application, however I have to stick with this for a while. Could you please advise any solutions to avoid error when multiple users update Access database in this case ? Is there a way to detect if database is being updating by others and script to wait until that process to finish first. Any technical solution for this issue is welcome!
Thank you!
You need some type of flag to tell if anyone is updating the table or not. Examples of what this flag can be:
An Excel file cell (that is probably the easiest in your case; if multiple excel files are used, just link to the one cell)
A field in an Access table (even a table with a single field and a single record dedicated just for that)
A (text) file in your shared drive (the flag can be the content of the file or even whether the file exists or not)
Then your update process would be:
- Check the flag, if set, loop until flag is cleared
- Set the flag
- Update the table
- Clear the flag
You will probably also need some way for the users (or just you) to clear the flag manually, in case something else goes wrong while updating the table and the flag gets stuck raised.
Well , this is not probably the most elegant solution
but you may create a field in a table , and ask for it before working with the table
something like this :
Set LockedStatus= oDB.OpenRecordset("mycontroltable")
if LockedStatus("lockedSuppiers")=False then
oDB.Execute"update mycontroltable set lockedSuppiers=true"
Set oRS = oDB.OpenRecordset("tblSuppliers")
For i = 2 To oSelect.Rows.Count 'skip label row
oRS.AddNew
For j = 1 To oSelect.Columns.Count 'Field(0) is Auto#
oRS.Fields(j) = oSelect.Cells(i, j)
........
......
oDB.Execute"update mycontroltable set lockedSuppiers=false"
end if
i am trying to write a code to open VBA and do search based on the cell value in A1 (integer). i managed to write a code up to point where i can open the lotus notes and go to specific database. I tried many online codes but couldn't manage to find the code to search in that database. "Lotus.NotesSession" doesn't work the excel version i use. Could you please help me to finish this code. Code is below:
Sub macro4()
Dim uiWs As Object
Dim dbname As String
Dim serverName As String
Dim db As NotesDatabase
Dim doccol As NotesDocumentCollection
Dim varA As Integer
dbname = "***"
serverName = "***"
Set uiWs = CreateObject("Notes.NotesUIWorkSpace")
Call uiWs.OpenDatabase(serverName, dbname)
Set db = uiWs.GetDatabase(serverName, dbname) ---->where i get the error
varA.Value = Sheets("sheet1").Range("A1").Value
Set doccol = db.FTSearch(varA, Nothing, 0)
End Sub
In Notes there are two "parent"- classes to derive everything from. The NotesUIWorkspace is the class for the "frontend": It contains everything that you SEE in the client. The NotesSession is the class for the backend. NotesDatabase is a backend- class. To correctly get your database, you need to use NotesSession:
Set ses = CreateObject("Notes.NotesSession")
Set db = ses.GetDatabase(serverName, dbname)
You mixed up COM and OLE Integration. The thing you tried to use (Lotus.NotesSession) is for COM only and you need to include Notes in your project to use this.
For your example to work you need to use the OLE integration: Notes.NotesSession
Now to your "Search"- Code:
There are two different ways to search a NotesDatabase:
There is the Fulltextsearch and the "normal" search.
The Fulltextsearch just searches for your value everywhere in all documents and returns a collection. A search for "Tom" in a mailfile will find all mails / calendar entries that where:
sent by Tom
received by Tom
have the word "Tom" in subject or body or an attachment of the mail.
The syntax for FTSearch is:
Set doccol = db.FTSearch( YourSearchValue )
You can restrict the search to one certain field by using a special syntax for your search. e.G. to only search in the "From" field you could write
[From] = "YourSearchValue"
In FTSearch the "=" always means "contains"
The normal search uses a Formula (in #Formula- syntax) to search for a document. It needs the right syntax, otherwise it will not find anything. A formula to search all documents that come from "Tom" would be:
#Contains( From ; "Tom" )
The syntax for search is:
Set doccol = db.Search( YourQueryAsExampleAbove, Nothing, 0 )
With Nothing = Cutoffdate (if given only return documents created or modified after the date) and 0 = max. number of documents to return (0 = return everything).
So your example code for the could be something like:
strQuery = "FieldToSearch = " & Sheets("sheet1").Range("A1").Value
Set doccol = db.Search( strQuery, Nothing, 0 )
After calling OpenDatabase successfully, you can use
set uiDb = uiWS.CurrentDatabase
That will get a NotesUIDatabase object, and then you can use
set db= uiDb.Database
That will get you the NotesDatabase object that you need in order to call the FTSearch method.
I am coding a Manager in Excel-VBA with several buttons.
One of them is to generate a tab using another Excel file (let me call it T) as input.
Some properties of T:
~90MB size
~350K lines
Contains sales data of the last 14 months (unordered).
Relevant columns:
year/month
total-money
seller-name
family-product
client-name
There is not id columns (like: cod-client, cod-vendor, etc.)
Main relation:
Sellers sells many Products to many Clients
I am generating a new Excel tab with data from T of the last year/month grouped by Seller.
Important notes:
T is the only available input/source.
If two or more Sellers sells the same Product to the same Client, the total-money should be counted to all of those Sellers.
This is enough, now you know what I have already coded.
My code works, but, it takes about 4 minutes of runtime.
I have already coded some other buttons using smaller sources (not greater than 2MB) which runs in 5 seconds.
Considering T size, 4 minutes runtime could be acceptable.
But I'm not proud of it, at least not yet.
My code is mainly based on Scripting.Dictionary to map data from T, and then I use for each key in obj ... next key to set the grouped data to the new created tab.
I'm not sure, but here are my thoughts:
If N is the total keys in a Scripting.Dictionary, and I need to check for obj.Exists(str) before aggregating total-money. It will run N string compares to return false.
Similarly it will run maximun N string compares when I do Set seller = obj(seller_name).
I want to be wrong with my thoughts. But if I'm not wrong, my next step (and last hope) to reduce the runtime of this function is to code my own class object with Tries.
I will only start coding tomorrow, what I want is just some confirmation if I am in the right way, or some advices if I am in the wrong way of doing it.
Do you have any suggestions? Thanks in advance.
Memory Limit Exceeded
In short:
The main problem was because I used a dynamic programming approach of storing information (preprocessing) to make the execution time faster.
My code now runs in ~ 13 seconds.
There are things we learn the hard way. But I'm glad I found the answer.
Using the Task Manager I was able to see my code reaching 100% memory usage.
The DP approach I mentioned above using Scripting.Dictionary reached 100% really faster.
The DP approach I mentioned above using my own cls_trie implementation also reached 100%, but later than the first.
This explains the ~4-5 min compared to ~2-3 min total runtime of above attempts.
In the Task Manager I could also see that the CPU usage never hited 2%.
Solution was simple, I had to balance CPU and Memory usages.
I changed some DP approaches to simple for-loops with if-conditions.
The CPU usage now hits ~15%.
The Memory usage now hits ~65%.
I know this is relative to the CPU and Memory capacity of each machine. But in the client machine it is also running in no more than 15 seconds now.
I created one GitHub repository with my cls_trie implementation and added one excel file with an example usage.
I'm new to the excel-vba world (4 months working with it right now). There might probably have some ways to improve my cls_trie implementation, I'm openned to suggestions:
Option Explicit
Public Keys As Collection
Public Children As Variant
Public IsLeaf As Boolean
Public tObject As Variant
Public tValue As Variant
Public Sub Init()
Set Keys = New Collection
ReDim Children(0 To 255) As cls_trie
IsLeaf = False
Set tObject = Nothing
tValue = 0
End Sub
Public Function GetNodeAt(index As Integer) As cls_trie
Set GetNodeAt = Children(index)
End Function
Public Sub CreateNodeAt(index As Integer)
Set Children(index) = New cls_trie
Children(index).Init
End Sub
'''
'Following function will retrieve node for a given key,
'creating a entire new branch if necessary
'''
Public Function GetNode(ByRef key As Variant) As cls_trie
Dim node As cls_trie
Dim b() As Byte
Dim i As Integer
Dim pos As Integer
b = CStr(key)
Set node = Me
For i = 0 To UBound(b) Step 2
pos = b(i) Mod 256
If (node.GetNodeAt(pos) Is Nothing) Then
node.CreateNodeAt pos
End If
Set node = node.GetNodeAt(pos)
Next
If (node.IsLeaf) Then
'already existed
Else
node.IsLeaf = True
Keys.Add key
End If
Set GetNode = node
End Function
'''
'Following function will get the value for a given key
'Creating the key if necessary
'''
Public Function GetValue(ByRef key As Variant) As Variant
Dim node As cls_trie
Set node = GetNode(key)
GetValue = node.tValue
End Function
'''
'Following sub will set a value to a given key
'Creating the key if necessary
'''
Public Sub SetValue(ByRef key As Variant, value As Variant)
Dim node As cls_trie
Set node = GetNode(key)
node.tValue = value
End Sub
'''
'Following sub will sum up a value for a given key
'Creating the key if necessary
'''
Public Sub SumValue(ByRef key As Variant, value As Variant)
Dim node As cls_trie
Set node = GetNode(key)
node.tValue = node.tValue + value
End Sub
'''
'Following function will validate if given key exists
'''
Public Function Exists(ByRef key As Variant) As Boolean
Dim node As cls_trie
Dim b() As Byte
Dim i As Integer
b = CStr(key)
Set node = Me
For i = 0 To UBound(b) Step 2
Set node = node.GetNodeAt(b(i) Mod 256)
If (node Is Nothing) Then
Exists = False
Exit Function
End If
Next
Exists = node.IsLeaf
End Function
'''
'Following function will get another Trie from given key
'Creating both key and trie if necessary
'''
Public Function GetTrie(ByRef key As Variant) As cls_trie
Dim node As cls_trie
Set node = GetNode(key)
If (node.tObject Is Nothing) Then
Set node.tObject = New cls_trie
node.tObject.Init
End If
Set GetTrie = node.tObject
End Function
You can see in the above code:
I hadn't implemented any delete method because I didn't need it till now. But it would be easy to implement.
I limited myself to 256 children because in this project the text I'm working on is basically lowercase and uppercase [a-z] letters and numbers, and the probability that two text get mapped to the same branch node tends zero.
as a great coder said, everyone likes his own code even if other's code is too beautiful to be disliked [1]
My conclusion
I will probably never more use Scripting.Dictionary, even if it is proven that somehow it could be better than my cls_trie implementation.
Thank you all for the help.
I'm convinced that you've already found the right solution because there wasn't any update for last two years.
Anyhow, I want to mention (maybe it will help someone else) that your bottleneck isn't the Dictionary or Binary Tree. Even with millions of rows the processing in memory is blazingly fast if you have sufficient amount of RAM.
The botlleneck is usually the reading of data from worksheet and writing it back to the worksheet. Here the arrays come very userfull.
Just read the data from worksheet into the Variant Array.
You don't have to work with that array right away. If it is more comfortable for you to work with dictionary, just transfer all the data from array into dictionary and work with it. Since this process is entirely made in memory, don't worry about the performance penalisation.
When you are finished with data processing in dictionary, put all data from dictionary back to the array and write that array into a new worksheet at one shot.
Worksheets("New Sheet").Range("A1").Value = MyArray
I'm pretty sure it will take only few seconds
My requirement is, I am having a hundreds of views. I want to make them as standard colors and UI. Simple I am using for changing the font color for column header and column values by NotesViewColumn class. But I do not know that which class is having the property for action bar and View alternate color and Heaer style and etc.,
In javascript is also welcome., But it should change its property as a designer level.
Thanks in advance
You have 3 options:
The easiest one: Go and buy ezView from Ytria. Should take you less than an hour to sort your views out
Create one view that looks the way you want your views to look and then go through all the views in a script, rename them, create a new view based on your view template and copy the view columns from the old views and adjust the view selection formulas (all in LotusScript)
Export your views in DXL and run some XSLT or search/replace to adjust the properties
Hope that helps
I just ran this agent, to change all the views in my (small) test database to having alternate row colours, and it worked.
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim exporter As NotesDXLExporter
Dim importer As NotesDXLImporter
Dim out As String
Dim infile As string
Dim pointer As long
Dim filenum As Integer
Dim altrow As integer
Dim unid As String
Dim doc As notesdocument
Set db = session.currentdatabase
Set exporter = session.Createdxlexporter
Set importer = session.Createdxlimporter
Dim count As Integer
count = 1
ForAll v In db.views
unid = v.UniversalID
Set doc = db.getdocumentbyunid(unid)
out = exporter.Export(doc)
altrow = instr(out, "altrowcolor")
If altrow > 0 Then
pointer = InStr(altrow, out, "=")
out = Left(out,pointer) & "'#f7f7f7'" & Mid(out, pointer+10)
else
pointer = InStr(out, "bgcolor=")
pointer = InStr(pointer, out, " ")
out = Left(out,pointer) & "altrowcolor='#f7f7f7' " & Mid(out, pointer+1)
End if
Call importer.setinput(out)
Call importer.setoutput(db)
importer.Designimportoption = 5
importer.Documentimportoption = 5
Call importer.Process()
out = ""
infile = ""
count = count + 1
End ForAll
Print count & " views processed"
End Sub
If your view designs are much bigger, you might want to use a NotesStream instead of String for "out". In that case, from the Help Files, I believe that the stream has to be closed and re-opened before you can use it for import.
For further research, I suggest writing "out" to a file, and examining the xml to find other "hidden" parameters.
Have fun, Phil
I can also recommend ezView. Makes it a piece of cake to modify views. I also use actionBarEZ to modify action bars across applications.
I blogged about a few different development tools I use in Domino Designer, you can find the entry here: http://www.bleedyellow.com/blogs/texasswede/entry/mydevelopmenttools
I am setting up a Lotus Notes account to accept emails from a client, and automatically save each email as a plain text file to be processed by another application.
So, I'm trying to create my very first Agent in Lotus to automatically export the emails to text.
Is there a standard, best practices way to do this?
I've created a LotusScript Agent that pretty much works. However, there is a bug - once the Body of the memo exceeds 32K characters, it starts inserting extra CR/LF pairs.
I am using Lotus Notes 7.0.3.
Here is my script:
Sub Initialize
On Error Goto ErrorCleanup
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim uniqueID As Variant
Dim curView As NotesView
Dim docCount As Integer
Dim notesInputFolder As String
Dim notesValidOutputFolder As String
Dim notesErrorOutputFolder As String
Dim outputFolder As String
Dim fileNum As Integer
Dim bodyRichText As NotesRichTextItem
Dim bodyUnformattedText As String
Dim subjectText As NotesItem
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT OUTPUT LOCATIONS
outputFolder = "\\PASCRIA\CignaDFS\CUser1\Home\mikebec\MyDocuments\"
notesInputFolder = "IBEmails"
notesValidOutputFolder = "IBEmailsDone"
notesErrorOutputFolder="IBEmailsError"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set db = session.CurrentDatabase
Set curview = db.GetView(notesInputFolder )
docCount = curview.EntryCount
Print "NUMBER OF DOCS " & docCount
fileNum = 1
While (docCount > 0)
'set current doc to
Set doc = curview.GetNthDocument(docCount)
Set bodyRichText = doc.GetFirstItem( "Body" )
bodyUnformattedText = bodyRichText.GetUnformattedText()
Set subjectText = doc.GetFirstItem("Subject")
If subjectText.Text = "LotusAgentTest" Then
uniqueID = Evaluate("#Unique")
Open "\\PASCRIA\CignaDFS\CUser1\Home\mikebec\MyDocuments\email_" & uniqueID(0) & ".txt" For Output As fileNum
Print #fileNum, "Subject:" & subjectText.Text
Print #fileNum, "Date:" & Now
Print #fileNum, bodyUnformattedText
Close fileNum
fileNum = fileNum + 1
Call doc.PutInFolder(notesValidOutputFolder)
Call doc.RemoveFromFolder(notesInputFolder)
End If
doccount = doccount-1
Wend
Exit Sub
ErrorCleanup:
Call sendErrorEmail(db,doc.GetItemValue("From")(0))
Call doc.PutInFolder(notesErrorOutputFolder)
Call doc.RemoveFromFolder(notesInputFolder)
End Sub
Update
Apparently the 32KB issue isn't consistent - so far, it's just one document that starts getting extra carriage returns after 32K.
With regards the 32Kb thing, instead of this:
Set bodyRichText = doc.GetFirstItem( "Body" )
... you might want to consider iterating all "Body" fields in the email document. When dealing with large amounts of rich text, Domino "chunks" said content into multiple rich text fields. Check some documents you're processing: you may well see multiple instances of the "Body" field when you look at document properties.
I'm not sure what is causing the 32K bug, but I know there are lots of limitations in the order of 32K or 64K within Lotus Notes, so perhaps you're running into one of those. I can't imagine what would add extra CR/LFs. Perhaps you could try using the GetFormattedText method on the NotesRichTextItem class and see if it fares better?
It's more complicated, but you might also be able to use the NotesRichTextNavigator class to iterate through all the paragraphs in the memo, outputting them one at a time. Breaking up the output that way might eliminate the CR/LF problem.
Lastly I always suggest Midas' LSX for dealing with rich text in Lotus Notes. They sell an add-on that gives you much more control over rich text fields.
As for best practices, one that comes to mind when I read your code is the looping construct. It is more efficient to get the first document in a view, process it, and then get the next doc and check whether it is equal to Nothing. That sets the loop to run through the view in index order, and eliminates the need to search through the index to find the Nth document each time. It also saves you from maintaining a counter. The gist is as follows:
Set doc = curview.GetFirstDocument()
While Not (doc Is Nothing)
'Do processing here...
Set doc = curview.GetNextDocument(doc)
Wend
The external eMail most likely comes in as MIME. So you could check the document.hasMime and then use the mime classes to get to the content. Then you don't have a 64k limit. Samples are in the help - or reply if you want code.