VBA 7.1 Setting multiple class properties by looping through a collection - vba

Question

self-taught VBA noob here. If I'm breaching ettiquette or asking something that everyone else knows already I'm sorry. Also, if I'm doing things that appear insane, it's because it is the only way I can either think of or actually make work. There's a department here at my work than can turn my makeshift code into something decent, but I have to give them a workable model first.
I have two programs with native VBA. One is a terminal emulator which I'm using to scrape mainframe data and to construct a custom class object, and then intend to pass it to MS Excel for number crunching. I am stuck with VBA until I can convince the IT folks that I am worthy of a Visual Studio license and scripting access. Also I have to pass the class in memory and not a spreadsheet in case of a program crash; no loose, easily recoverable data in lost files allowed.
The data is an invoice that has up to 99 lines, each line can bill an item or a service. The invoice is a custom invoice class, and each line is a custom line class contained in a collection of lines. I have everything built and working, but I'm stuck trying to set the line objects to their invoice line properties. Something with the effect of this:
For x = 1 To intLines
Invoice.Linex = cLines.Item(x)
Next x
hoping that in Excel I can use the invoice like this:
currTotalChrg = Invoice.Line01.Charge + Invoice.Line02.Charge
I've looked at the CallByName function but couldn't get it to work, and couldn't find an online example to show me how to set it up properly. Without that, I don't know how to make what I've seen others call a wrapper to construct and execute the lines. If I must, I can construct a SelectCasenstein to do the job, but there's got to be a better way. Since I can't post code (proprietary issues and government regulations), I am perfectly fine with vague answers; I can figure out the nuts and bolts if pointed in the right direction.
Thanx for the time and help!

Answer 1

Seems you want an Invoice collection class that holds InvoiceLineItem objects and exposes a TotalAmount property.
You can't edit module/member attributes directly in the VBE, but if you want to be able to iterate the line items of an invoice with a nice For Each loop, you'll have to find a way. One way is to export the class and edit it in your favorite text editor to add the attributes, save it, and then re-import it into your VBA project. Next release of Rubberduck will let you do that with "annotations" (magic comments), which I'm also including here:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Invoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Const MAX_LINE_ITEMS As Long = 99
Private Type TInvoice
InvoiceNumber As String
InvoiceDate As Date
'other members...
LineItems As Collection
End Type
Private this As TInvoice
Private Sub Class_Initialize()
this.LineItems = New Collection
End Sub
'#Description("Adds an InvoiceLineItem to this invoice. Raises an error if maximum capacity is reached.")
Public Sub AddLineItem(ByVal lineItem As InvoiceLineItem)
Attribute AddLineItem.VB_Description = "Adds an InvoiceLineItem to this invoice."
If this.LineItems.Count = MAX_LINE_ITEMS Then
Err.Raise 5, TypeName(Me), "This invoice already contains " & MAX_LINE_ITEMS & " items."
End If
this.LineItems.Add lineItem
End Sub
'#Description("Gets the line item at the specified index.")
'#DefaultMember
Public Property Get Item(ByVal index As Long) As InvoiceLineItem
Attribute Item.VB_Description = "Gets the line item at the specified index."
Attribute Item.VB_UserMemId = 0
Set Item = this.LineItems(index)
End Property
'#Description("Gets an enumerator that iterates through line items.")
'#Enumerator
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through line items."
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = this.LineItems.[_NewEnum]
End Property
'...other members...
You could implement the sum outside the class, but IMO that would be feature envy; an invoice wants to be able to tell you its total amount & quantity.
So I would expose properties for that:
'#Description("Gets the total amount for all line items.")
Public Property Get TotalAmount() As Double
Dim result As Double
Dim lineItem As InvoiceLineItem
For Each lineItem In this.LineItems
result = result + lineItem.Amount
Next
TotalAmount = result
End Property
'#Description("Gets the total quantity for all line items.")
Public Property Get TotalQuantity() As Double
Dim result As Double
Dim lineItem As InvoiceLineItem
For Each lineItem In this.LineItems
result = result + lineItem.Quantity
Next
TotalQuantity = result
End Property
And then you might as well...
'#Description("Gets the total net amount for all line items (including taxes, discounts and surcharges).")
Public Property Get TotalNetAmount() As Double
TotalNetAmount = TotalAmount - TotalDiscounts + TotalSurcharges + TaxAmount
End Property
From your post and the nature of your question I suspect your class has.. what, 99 properties, one for each line on the invoice?
I am stuck with VBA until I can convince the IT folks that I am worthy of a Visual Studio license and scripting access.
VBA is just as object-oriented a language as any other "real" language you could use with Visual Studio. The above solution is fairly similar to how I would have implemented it in C#, or VB.NET. If your VBA class has a member for every single possible invoice line, your thinking is wrong - not the language you're using.
Stop hating VBA for the wrong reasons. The editor sucks, get over it.

Answer 2

I have a partial answer for you: not exactly what you asked for, but it shows you a syntax that can do it.
I have a 'totals' class - a simple wrapper for a dictionary - that allows you to specify named fields and start adding up values. It's trivial, and there isn't much to be gained by doing it... But bear with me:
Dim LoanTotals As clsTotals
Set LoanTotals = New clsTotals
For Each Field In LoanFileReader.Fields
LoanTotals.CreateField Field.Name
Next Field
For Each LineItem In LoanFileReader
LoanTotals.Add "LoanAmount", LineItem!LoanAmount
LoanTotals.Add "OutstandingBalance", LineItem!OutstandingBalance
LoanTotals.Add "Collateral", LineItem!Collateral
Next LineItem
The implementation details in the class aren't terribly interesting - you can work out that it all ends in Debug.Print LoanTotals.Total("LoanAmount")
...But what if I implemented this?
Dim LoanTotals As clsTotals
Set LoanTotals = New clsTotals
For Each Field In LoanFileReader.Fields
LoanTotals.CreateCommand Field.Name, Field.MainframeCommand
Next Field
...With an internal implementation like this:
Public Sub ExecuteCommand(CommandName, ParamArray() Args())
' Wrapper for objMainService, ends a command to the COM interface of the Mainframe client
CallByName objMainService, CommandName, vbMethod, Args
End Sub
Altenatively, you can concatenate Shell commands to execute those mainframe functions.
...And now you've populated a VB class that encapsulates a primitive API for a set of functions supplied at runtime.
As I say: it's not quite what you wanted, but it might get you somewhat closer to the solution you need.
For completeness, here's the code for the 'Totals' class:
A VBA Class for aggregating totals on named fields specified at runtime:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsTotals"
Attribute VB_Description = "Simple 'Totals' class based on a Scripting.Dictionary object"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' Simple 'Totals' class based on a Scripting.Dictionary object
' Nigel Heffernan, Excellerando.Blogspot.com April 2009
' As it's based on a dictionary, the 'Add' and 'Reset' methods
' support implicit key creation: if you use a new name (or you
' mistype an existing name) a new Totals field will be created
' Coding Notes:
' This is a wrapper class: 'Implements' is not appropriate, as
' we are not reimplementing the class. Or not very much. Think
' of it as the 'syntactic sugar' alternative to prefixing all
' our method calls in the extended class with 'Dictionary_'.
Private m_dict As Scripting.Dictionary
Attribute m_dict.VB_MemberFlags = 40
Attribute m_dict.VB_VarDescription = "(Internal variable)"
Public Property Get Sum(FieldName As String) As Double
Attribute Sum.VB_Description = "Returns the current sum of the specified field."
Attribute Sum.VB_UserMemId = 0
' Returns the current sum of the specified field
Sum = m_dict(FieldName)
End Property
Public Sub CreateField(FieldName As String)
Attribute CreateField.VB_Description = "Explicitly create a new named field"
' Explicitly create a new named field
If m_dict.Exists(FieldName) Then
Err.Raise 1004, "Totals.CreateField", "There is already a field named '" & FieldName & "' in this 'Totals' object."
Else
m_dict.Add FieldName, 0#
End If
End Sub
Public Sub Add(FieldName As String, Value As Double)
Attribute Add.VB_Description = "Add a numeric amount to the field's running total \r\n Watch out for implicit field creation."
' Add a numeric amount to the field's running total
' Watch out for implicit field creation.
m_dict(FieldName) = m_dict(FieldName) + Value
End Sub
Public Sub Reset(FieldName As String)
Attribute FieldName.VB_Description = "Reset a named field's total to zero \r\n Watch out for implicit key creation"
' Reset a named field's total to zero
' Watch out for implicit key creation
m_dict(FieldName) = 0#
End Sub
Public Sub ResetAll()
Attribute ResetAll.VB_Description = "Clear all the totals"
' Clear all the totals
m_dict.RemoveAll
Set m_dict = Nothing
End Sub
Public Property Get Fields() As Variant
Attribute Fields.VB_Description = "Return a zero-based vector array of the field names"
'Return a zero-based vector array of the field names
Fields = m_dict.Keys
End Property
Public Property Get Values() As Variant
Attribute Values.VB_Description = "Return a zero-based vector array of the current totals"
'Return a zero-based vector array of the current totals
Fields = m_dict.Items
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Return the number of fields"
'Return the number of fields
Count= m_dict.Count
End Property
Public Property Get Exists(FieldName As String) As Boolean
Attribute Count.VB_Description = "Return a zero-based vector array of the field names"
'Return True if a named field exists in this instance of clsTotals
Exists = m_dict.Exists(FieldName)
End Property
Private Sub Class_Initialize()
Set m_dict = New Scripting.Dictionary
m_dict.CompareMode = TextCompare
End Sub
Private Sub Class_Terminate()
m_dict.RemoveAll
Set m_dict = Nothing
End Sub
Comment out the Attribute statements if you can't import them into your project.