What sets limits on maximum Collection size/count in VBA? - excel

I am using a nested Collection to store validation data from Excel, of the form: coll1(case)(subtype)(item).
My code is essentially looping through a flat input list and bin sorting the contents into collections - the top level collection is a collection of validation data for all data sources (cases), the second tier is a type collection (within each case, there are different possible types/classes of data) and the final tier is the valid list of tags/labels for things of that particular class/type.
In the code below, inp is read in from a vertical stack of Excel cells, but is essentially a list of (unique) Strings of the form "\validation_data_class\case\type\label" - hence the Split() into the labels() array to then parse.
Public tag_data As Collection
Private Sub load_tags(inp As Variant)
Dim i As Long, label() As String
Dim case_name As String, type_name As String, tag_name As String
Dim tmp_coll As Collection, tmp_coll2 As Collection
Set tag_data = New Collection
For i = LBound(inp) To UBound(inp) ' Check this works if only one entry in the list - may need IsArray() check
label = Split(inp(i, 1), "\")
Select Case label(1)
Case "tag"
' Extract the case name from the label and get its number, so we can store data in the right element of tag_data()
case_name = label(2): If Not KeyExists(tag_data, case_name) Then Set tmp_coll = New Collection: tag_data.Add tmp_coll, case_name
' Extract the type name from the label and store it, if needed
type_name = label(3): Set tmp_coll = tag_data(case_name)
If Not KeyExists(tmp_coll, type_name) Then Set tmp_coll2 = New Collection: tmp_coll.Add tmp_coll2, type_name
' Extract the actual tag and store it in the list (assumes we have ensured no duplicates already)
tag_name = label(4): Set tmp_coll = tag_data(case_name)(type_name)
Debug.Assert i < 719
tmp_coll.Add tag_name, tag_name
Case "prop"
' Still to implement
End Select
Next i
End Sub
Function KeyExists(coll As Collection, key As String) As Boolean
On Error GoTo ErrHandler
IsObject (coll.Item(key))
KeyExists = True
Exit Function
ErrHandler:
' Do nothing
End Function
The problem I am having is that it gets as far as my Debug.Assert line and then silently fails on that 719th addition to the lowest-level Collection. Weirdly it will run if I don't use keys for the lowest-level Collection, which then allows me to add the final 2 items (in this particular case, I need 721 items in that Collection, but it could be more or less in other scenarios).
I will take the workaround of not using Keys for that large Collection if I need to, but it makes my actual validation against this set of lists that bit harder later on, because I cannot just use the KeyExists method, but will have to write a slower function to crawl the un-labelled Collection looking for a match.

Related

Whats the simplest way to find for a group of user all the group membership?

I do have one domino group (Access Control List only), lets call them Main_Group.
This group includes all employees, that I want to know on which other domino groups they are member of.
Members of Main_Group:
- John Smith/ORGANIZATION
- Peter Smith/ORGANIZATION
- Jeff Smith/ORGANIZATION
Of course this list is much longer then these 3 entries.
I would look for each member in this group, in which other domino group this user is member and put this information into a CSV. The CSV should have a format like this:
UserName;DominoGroups
John Smith;Domino_Group1,Domino_Group2,Domino_Group3
Peter Smith;Domino_Group2
Jeff Smith;Domino_Group1,Domino_Group3
Whats the best way to achieve to this information? Lotus Script, any View with formula? Or is there already a notes database is doing this?
It's not simple. A person can be in a group through one or more levels of indirection. I.e., a person is in GroupA and GroupA is in GroupB, and GroupB is in GroupC, and GroupC is in GroupD, and by the way GroupE, GroupF, and GroupG... You will have to write code to recursively traverse groups, detect cycles, and come up with a definitive list of group memberships. As far as I know, there's never been an API exposed for this.
There is no simple way to get what you want. You could create a view in the adressbook, use the "Group"- view as template and add one categorized column for the item "Members". Unfortunately -as Richard wrote- you will not get nested group memberships like that.
You would need to:
Cycle through all group documents
recursively get all members for every group
whenever your user is in the members, then add the group name to a list / an array...
export the result
BUT: If you just need to know / see what groups a specific user is member of, then use the Domino Administrator Client. Open the "Groups" View, then the "Groups" pane and select "Manage groups". Then select the user in the leftmost panel and click on "Member hierarchie" on the right side, then you see the groups that this user is member of, even nested ones. Unfortunately you cannot export this information.
This code builds a list of dynamic arrays to act as key/value pairs (where each value is an array). It's built from the Group view in names.nsf. Rather than taking each group name and loading up the members, it builds it the other way round so for each member, it has an array of groups. Groups can be in other groups so it runs through each group recursively. In order to prevent loops (e.g. where group A is in group B and vice-versa) it uses the visited array which terminates that part of the search if the group has already been visited. The visited array ends up, upon completion of the recursion, the list of groups the user is in.
Building the key/value List initially would be quicker than multiple full text searches, especially if, rather than looking up one name, you're looping all user names in names.nsf as once the key/value list is built there's no need to query the database again. I've not built the loop for each user but it could be added quite easily to the getGroupsForUser function.
Code below
getGroupsForUser function. Returns a formatted string of each group that a user is in. The user name is the first item.
Function getGroupsForUser(userName As String) As String
If userName="" Then Exit function
Dim ns As New NotesSession, namesDatabase As NotesDatabase
Dim visited As Variant, groupKeyValueStore List As Variant
Dim returnString As String, separator As String, i As Integer
Set namesDatabase = ns.getDatabase(ns.Currentdatabase.Server, "names.nsf", False)
visited = Null
Call getGroupKeyValues(groupKeyValueStore, namesDatabase)
Call searchGroupsRecursive(userName, visited, groupKeyValueStore)
i=0
returnString = ""
ForAll item In visited
If i=0 Then separator = ""
If i=1 Then separator = ";"
If i>1 Then separator = ","
returnString = returnString + separator + item
i = i + 1
End forall
getGroupsForUser = returnString
End Function
getGroupKeyValues loops through the Groups view in names.nsf and creates the key/value List.
Public Function getGroupKeyValues(groupKeyValueStore List As Variant , namesDatabase As NotesDatabase)
Dim groupView As NotesView, doc As NotesDocument, members As Variant, groupName As String
Dim separator As String, values As Variant, i As Integer, tempString(0) As String
Set groupView = namesDatabase.getView("Groups")
Set doc=groupView.Getfirstdocument()
Do Until doc Is Nothing
groupName = doc.ListName(0)
members = doc.getItemValue("Members")
ForAll member In members
If IsElement(groupKeyValueStore(member)) Then
If IsNull(ArrayGetIndex(groupKeyValueStore(member), groupName)) Then
values = groupKeyValueStore(member)
i = ubound(values) + 1
ReDim Preserve values(i)
values(i) = groupName
groupKeyValueStore(member) = values
End If
Else
tempString(0) = groupName
groupKeyValueStore(member) = tempString
End If
End ForAll
Set doc=groupView.getNextDocument(doc)
Loop
End Function
searchGroupsRecursive recursively searches each group, ensuring no group is visited twice.
Public Function searchGroupsRecursive(userName As String, visited As Variant, groupKeyValueStore List As Variant) As Variant
Dim length As Integer, userNotesName As NotesName, fullUserName As String
Dim tempArray(0) As String
Set userNotesName = New NotesName(userName)
fullUserName = userNotesName.Canonical
If IsNull(visited) Then
tempArray(0) = userName
visited = tempArray
Else
length = UBound(visited)
ReDim Preserve visited(length + 1)
visited(length + 1) = userName
End If
If Not isElement(groupKeyValueStore(fullUserName)) Then Exit function
ForAll item In groupKeyValueStore(fullUserName)
Call searchGroupsRecursive(CStr(item), visited, groupKeyValueStore)
End ForAll
End Function

How can I create a proper Collection in VBA?

I am trying to convert a large 3 dimensioned Array into a series of class modules. I have each next class stored as an array in the previous class. It goes like Brand -> Products -> Lots.
I have successfully created this interaction and can access them by name like:
Sub test()
Dim MyBrand As Brand
Set MyBrand = New Brand
MyBrand.Name = "Company1"
MyBrand.AddProduct "Shoes"
MyBrand.Products("Shoes").AddLot "240502"
MsgBox MyBrand.Products("Shoes").Lots(0) 'Correctly Displays "240502"
End Sub
But then I wanted to create an object group that can save multiple Brand objects and access them like Brands("Company1").
If I used an array inside a class module, I'd end up with Brands.Brand("Company1").
If I used a Collection, I'd have to use indexes like Brands(1).
Is there a way to create a proper object group so that I can mimic the syntax of groups like Application.Workbooks and refer to members by Name?
A lot of the magic behind custom collections depends on hidden attributes that you cannot edit from within the VBE; you need to export (and remove from the project when prompted) the class module, edit its magic member attributes in Notepad/Notepad++, save changes, and then re-import the module into the project.
That's obviously tedious and error-prone, but there's a (much) better way.
In order to support this:
Set shoesProduct = MyBrand.Products("Shoes")
You can define Products as a Dictionary and call it a day, but then encapsulation as a concept is... well, taking a beating here (whether the internal collection is a Dictionary, a Collection, or a .NET ArrayList should typically be an implementation detail that the rest of the code doesn't need to care about).
I suspect the Brand class has too many responsibilities and "is" the product collection; best practices would be to have the Brand.Products property defined as follows:
Public Property Get Products() As Products
So you'll want to have a Products class (very much like the Workbook.Worksheets and Workbook.Sheets properties both return a Sheets collection object) that encapsulates a private, module-level VBA.Collection field (possibly keyed, but you can't access or iterate the keys of a collection).
The Products custom collection class needs an Item default property (the name Item is a convention); the implementation just pulls the item from the private encapsulated Collection:
'#DefaultMember
Public Property Get Item(ByVal Index As Variant) As Product
Set Item = ThePrivateCollection.Item(Index)
End Property
If you are using Rubberduck, this #DefaultMember annotation/comment is going to trigger an inspection result about the annotation and the corresponding hidden attribute(s) being "out of sync"; right-click that inspection result and pick "Adjust attribute values" to have Rubberduck generate the hidden code for you and deal with the annoying export/delete-edit-reimport cycle.
Otherwise, you'll want to manually edit the hidden VB_UserMemId member attribute that makes it the class' default member:
Public Property Get Item(ByVal Index As Variant) As Product
Attribute Item.VB_UserMemId = 0
Set Item = ThePrivateCollection.Item(Index)
End Property
And with that, MyBrand.Products("Shoes") becomes equivalent to MyBrand.Products.Item("Shoes").
Perhaps you want to iterate all the products in the collection, too?
For Each Product In MyBrand.Products
Debug.Print Product.Name
Next
In order to do this, you need a special "enumerator" member that forwards the enumerator from the encapsulated collection:
'#Enumerator
Public Property Get NewEnum() As IUnknown
Set NewEnum = ThePrivateCollection.[_NewEnum]
End Property
Again, Rubberduck annotations greatly simplify doing this, but everything Rubberduck does, you can also do manually if you like:
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = ThePrivateCollection.[_NewEnum]
End Sub
And now For Each iteration works for your custom object collection!
If a Lot was more than just a String value (i.e. an actual object type), then the Product class could use a Lots custom collection too - but since a Lot is really just a String value (or is it?), then Product can simply encapsulate a Dictionary, and have a Lots property that exposes the Items array:
Public Property Get Lots() As Variant
Lots = ThePrivateLotsDictionary.Items
End Property
Note, that's simpler than using a Collection, because with a collection you'd need to iterate it and copy each item to an array in order to return the items without exposing the collection itself (exposing Lots() As Collection makes the AddLot member completely redundant).
As for the Brands collection itself, heed Tim Williams' advice and use a Dictionary data structure.
You can use a Scripting.Dictionary with Name as the key:
Sub test()
Dim MyBrand As Brand
Dim Brands As Object
Set Brands = CreateObject("scripting.dictionary")
Set MyBrand = New Brand
MyBrand.Name = "Company1"
MyBrand.AddProduct "Shoes"
MyBrand.Products("Shoes").AddLot "240502"
Brands.Add MyBrand.Name, MyBrand
MsgBox Brands("Company1").Products("Shoes").Lots(0)
End Sub

What is the fastest method of sorting out duplicate strings

I am developing an app that focuses around manipulating strings in various ways. One of which is removing any duplicate items while combining files.
I have attempted to use this:
Private Sub run()
For Each filePath As String In ListBox1.Items
For Each Line In IO.File.ReadAllLines(filePath)
Dim founds() As String = Line.Split(":")
Dim hash As String = founds(0)
Dim word As String = founds(1)
foundList.Add(word)
Dim result As List(Of String) = foundList.Distinct().ToList
Label1.Text = result.Count
For Each addstring In result
ListBox2.Items.Add(addstring)
Next
Next
Next
End Sub
Distinct was very slow in this fashion, so I tried using:
Private Sub run()
For Each filePath As String In ListBox1.Items
For Each Line In IO.File.ReadAllLines(filePath)
Dim founds() As String = Line.Split(":")
Dim hash As String = founds(0)
Dim word As String = founds(1)
If Not foundList.Contains(word) Then
foundList.Add(word)
Label1.Text = foundList.Count
End If
Next
Next
For Each found In foundList
ListBox2.Items.Add(found)
Next
End Sub
This was much faster however still performs slower than what should be possible without using OpenCL or similar. I can write in C# if there is anything different available but this in .NET.
Can anyone suggest a faster or more effective method?
This can't possibly be it, surely I am missing something.
Fabio got to the obvious answer before I finished this. I've put some more detail in, but skip to the bottom for another idea.
The obvious speed issue is in the string comparison:
If Not foundList.Contains(word) Then
Comparing strings is a fairly expensive operation, and here you're comparing strings against a successively larger list of other strings. For a short list that might be OK, but when you're dealing with big lists it's going slow down somewhat.
The better option is to hash each string once then compare the hashes. There's some finesse required to handle hash collisions, but when the bulk of the data is unique and the hash function is good then you'll get a huge improvement in the speed.
In .NET the HashSet(Of T) class implements hash-based storage and lookup.
Being a Set, HashSet will only hold one of any particular value, which handles the duplication issue. It makes no guarantees about retaining the order of its contents, but in practice if you are adding only and never removing items then order is preserved.
Lookups in HashSet are very fast due to the way the hash values are stored and indexed internally. Testing to see if a value exists in the set is almost unaffected by the number of items in the list. I get lookup times on the order of ~50ns for lookups in lists from 1,000 to 1,000,000 strings with a simple test (100,000,000 lookups).
For your purposes the usage would be something like (in C#):
Private Sub Run()
' shortcut the file reads...
Dim items = ListBox1.Items.OfType(Of String)()
.SelectMany(Function(fn) File.ReadAllLines(fn))
.Select(Function(i) i.Split(":"c)(1))
Dim hash = New HashSet(Of String)(items)
ListBox2.Items.Clear()
ListBox2.Items.AddRange(hash.ToArray())
End Sub
(Sorry, VB is not my native language.)
Question is, will this actually speed things up? You'll need to do some testing of your own, but I suspect that the answer might be: not much.
Yes, it's faster than using Distinct and ToArray to get an array of sorted values. Almost twice as fast by my simple test. ~180ms vs ~275ms for a million distinct 36-character strings (yes, they're Guids) in an array. Not much of an increase. YMMV, but if the operation is taking significantly more time than that then the Distinct is probably not your biggest problem.
Do some profiling and find the actual pain point. I suspect that you'll find that ListBox2 has the Sorted flag set. Try this (again in C#, sorry):
Private Sub Run()
{
Dim items = ListBox1.Items.OfType(Of String)().
SelectMany(Function(fn) File.ReadAllLines(fn)).
Select(Function(i) i.Split(":"c)(1))
Dim hash = HashSet<string>(items)
ListBox2.Items.Clear()
Dim sorted = ListBox2.Sorted
ListBox2.Sorted = false
ListBox2.Items.AddRange(hash.ToArray())
ListBox2.Sorted = sorted
}
If that's a lot faster then the problem isn't in the Distinct it's in the sort-on-insert which is painfully slow and almost always the worst option for sorted lists.
If it's not then the problem might be
Get all values before using Distinct and adding them (the slowest part is still updating the control):
ListBox2.DataSource = (From line In IO.File.ReadLines(filePath)
Select line.Split(":"c)(1) Distinct).ToList
Use HashSet(Of String)
Dim lines = IO.File.ReadAllLines(filePath)
Dim uniqueLines = New HashSet(Of String)(values)
After initialization HashSet will contains unique values.
You can use HashSet(Of T).Add(value) method - which return true if value was added to the set and false if value already exists in the set
Dim isAdded As Boolean = uniqueLines.Add("someValue")
If isAdded Then
' Do something if added
Else
' Do something if already exists
End if
HashSet have method Contains which algorithm is O(1) - use fixed amount of operations, where for example List.Contains method will iterate whole list until find given value (O(N) - amount of operation is equal amount of items in worth case)
So your function can be re-written as below
Private Sub run()
' get data
Dim allItems = ListBox1.Items.
SelectMany(Function(path) IO.File.ReadAllLines(path)).
SelectMany(Function(line) Line.Split(":"))
Dim uniqueItems = New HashSet(Of String)(allItems)
' update controls
Label1.Text = uniqueItems.Count.ToString()
ListBox2.Items.AddRange(uniqueItems.ToArray())
End Sub
Notice that items added to the ListBox2 by using .AddRange method. This method will add items in one operation and re-draw control only one time. Where when you adding items one by one (using .Add method) you control re-drawing itself for every added item, which can be "heavy" for big amount of items.

Exporting Business Account attributes with Acumatica API

Our Business Accounts in Acumatica have 13 custom Attributes for our main Business Account Class. I've been able to save values to the Attributes successfully, based on Acumatica's example "Adding Records to the Business Accounts and Opportunities Forms". But I have not been able to figure out how to retrieve the values with an Export.
First, I tried using a format similar to how the field was specified when saving them.
Public Function GetCustomerAttributes(ByVal customerID As String) As String()()
Dim customer As CR303000Content = m_context.CR303000GetSchema()
m_context.CR303000Clear()
Dim idFilter As Filter = New Filter()
idFilter.Field = customer.AccountSummary.BusinessAccount
idFilter.Condition = FilterCondition.Equals
idFilter.Value = customerID
' SIMILAR TO EXAMPLE FOR SAVING
Dim awdField As Field = New Field()
awdField.ObjectName = customer.Attributes.Attribute.ObjectName
awdField.FieldName = "AWD Number"
Dim searchfilters() As Filter = {idFilter}
Dim searchCommands() As Command = {awdField}
Dim searchResult As String()() = m_context.CR303000Export(searchCommands, searchfilters, 0, False, False)
Return searchResult
End Function
I thought this would return one result with the value for our attribute named "AWD Number". Instead, it returned 13 results, one for each attribute, and the value of each one was blank. I changed the FieldName to customer.Attributes.Attribute.FieldName and then it started returning the name of each attribute. So I thought if I added another field for the value, then I might get the name and value in separate results, like this:
Public Function GetCustomerAttributes(ByVal customerID As String) As String()()
Dim customer As CR303000Content = m_context.CR303000GetSchema()
m_context.CR303000Clear()
Dim idFilter As Filter = New Filter()
idFilter.Field = customer.AccountSummary.BusinessAccount
idFilter.Condition = FilterCondition.Equals
idFilter.Value = customerID
Dim awdField As Field = New Field()
awdField.ObjectName = customer.Attributes.Attribute.ObjectName
awdField.FieldName = customer.Attributes.Attribute.FieldName
Dim awdValue As Field = New Field()
awdValue.ObjectName = customer.Attributes.Attribute.ObjectName
awdValue.FieldName = customer.Attributes.Attribute.Value
Dim searchfilters() As Filter = {idFilter}
Dim searchCommands() As Command = {awdField, awdValue}
Dim searchResult As String()() = m_context.CR303000Export(searchCommands, searchfilters, 0, False, False)
Return searchResult
End Function
I did get a 2-item array back for each of the 13 results, but the value in the second field was still blank.
Does anyone know how I can get the values? I don't really care if I have to get them one at a time, but I'd prefer to get them all at once with their names or codes so that I don't have to rely on the indices always staying the same. Below are images of the debugger running on my second example and view in Acumatica. Thanks!
Your first attempt is correct, however you're not using the right object name and field name. The system will dynamically add fields to the primary object (view) of the screen, in this case the object name represented by customer.AccountSummary.BusinessAccount.ObjectName variable (I suggest you use the debugger to see what this value equals too - good learning exercise).
The attribute field name will use the same naming convention as used in How To Retrieve An Attribute Field In StockItems In Acumatica API?. The naming convention is _Attributes. The attribute ID is not the attribute name; I don't see your configuration but I doubt in your case the Attribute ID is "AWD Number". To summarize, the code will look like:
Dim awdField As Field = New Field()
awdField.ObjectName = customer.AccountSummary.BusinessAccount.ObjectName
awdField.FieldName = "AWDNumber_Attributes"
In your example, by putting the Attributes.Attribute.ObjectName object, the system will iterate through all values inside this table, and then return for every row the fields you want. I'm not exactly sure why you're not seeing all the attribute values in this case, but I think you should be fine with the example above.

Creating a Container Property in a VBA Class which returns Indexed Items (Excel VBA 2003)

I started learning VBA for my job at the end of last summer, and I can proudly say this is the first time I haven't be able to find the answer on Google. I started teaching myself about Classes this week, and I have come across a situation where I would like to be able to identify an "indexed property" for my class.
Since that probably isn't the clearest explanation, here is a hypothetical example:
The class which I have created for my super awesome sandwich shop (clsSASS) contains properties for Calories, Weight in Grams, Price, and Ingredients. The first three are variables with very straight forward let and get statements. I.E.:
Public pCal As Integer
Public Property Get Calories() As Integer
Calories= pCal
End Property
Public Property Let Calories(Value As Integer)
pCal = Value
End Property
Ingredients however is designed to contain, in order of entry, the list of ingredients. My initial instinct was to do something like this:
Public pIngd As Collection
Public Property Get Ingredients(Value As Integer) As Collection
Ingredients = pIngd(Value)
End Property
Public Property Set Ingredients(Object As Collection)
Set pIngd = Object
End Property
So if Bacon were the first ingredient in the list (and let's be honest it always would be), something like clsNewSandwich.Ingredients(1) would return the string 'Bacon'.
The problem arose when I added a container property to a class, and then couldn't figure out how to identify the individual items in the container. So this may just be a simple syntax issue that has nothing to do with classes whatsoever.
Many Thanks!
*edited for clarity/continuity
OK - I will retract my advice about always naming let/set and Get the same, since in this case you cannot, since the "input" and "output" types are not the same. So, in the sample below I've named the property which just returns one ingredient as Ingredient
Class "clsSASS":
Dim pIngd As Collection
Property Set Ingredients(c As Collection)
Set pIngd = c
End Property
Property Get Ingredient(v As Integer) As String
Ingredient = pIngd(v)
End Property
Regular module:
Sub Tester()
Dim c As New Collection
Dim s As New clsSASS
c.Add "bacon"
c.Add "lettuce"
c.Add "tomato"
Set s.Ingredients = c
Debug.Print s.Ingredient(1) 'bacon
Debug.Print s.Ingredient(2) 'lettuce
Debug.Print s.Ingredient(3) 'tomato
End Sub

Resources