VBA - Create object to redirect "Write" method - vba

Right now I have an module where I call an object with the "write" method.
I do this 500 places around in the code, and now I need to support 2 objects instead of only 1 - But I will only write to one of them depending on an variable state
So originally I would have to write
If var = 1 Then
Module1.Obj1.Write("some_data")
Else If var = 0 Then
Module1.Obj2.Write("some_other_data")
End If
How do I create an object that can redirect the data based on an variable so I can write like:
Module1.ObjX.Write("data_here")
And down in the ObjX it reads "var" and if var = 1 then writes to Obj1 or if var = 0 write to Obj2
'if var = 1 then
Module1.Obj1.Write("data")
else if var = 0 then
Module1.Obj2.Write("data")
It would make the code easier to understand and save a lot of work :S

A standard way of doing what you want is to create a dictionary of key value pairs. The key is the value that selects which object you need to use to write and the value associated with the Key is the object you will use. The code below uses a scripting.dictionary to achieve this.
At the module Level
Public myWriter as Scripting.Dictionary
In an initialisation subroutine
Set myWriter = New Scripting.Dictionary
with myWriter
.Add 1,Obj1
.Add 0.Obj2
.Add 3.Obj3
' etc
End With
To call the approprite write function you can now just use
myWriter.Item(var).Write(DataValue)
'

Pass the object by reference into a write function instead:
Sub WriteData(ByRef obj, ByVal data)
'Write the data using the object here
End Sub
WriteData(Obj1, "data")
WriteData(Obj2, "data")

Change the value of writervar before you call write object
Since writervar is global you can edit the value anywhere in your code.
Public writervar as Integer ' global scope
Public Sub WriteObj(Data)
Select Case writervar
Case 0
' do stuff
Case 1
' do stuff
Case Else
' error
End Select
End Sub

Related

How to set 2 arguments on Let function in a class in vba (for excel)?

I am creating a Class in vba (for excel) to process blocks of data. After some manipulation of a text file I end up with blocks of data (variable asdatablock() ) which I want to process in a For Loop
I created my own Class called ClDataBlock from which I can get key data by a simple call of the property required. 1st pass seems to work and I am now trying to expand my Let function to 2 argument but it’s not working. How do I specify the 2nd argument?
Dim TheDataBlock As New ClDataBlock
For i = 0 to UBound(asdatablock)
asDataBlockLine = Split(asdatablock(i), vbLf) ‘ split block into line
TheDataBlock.LineToProcess = asDataBlockLine(5) ‘allocate line to process by the class
Dvariable1 = TheDataBlock.TheVariable1
‘and so on for the key variables needed base don the class properties defined
Next i
In the Class Module the Let function takes 2 arguments
Public Property Let LineToProcess(stheline As String, sdataneeded As String)
code extract of what I am looking at -
'in the class module
Dim pdMass As Double
Private pthelineprocessed As String
Public Property Let LineToProcess(stheline As String, sdataneeded As String)
pthelineprocessed = DeleteSpaces(Replace(stheline, vbLf, ""))
Dim aslinedatafield() As String
Select Case sdataneeded
'THIS IS AN EXTRACT FROM THE FUNCTION
'THERE ARE AS NUMBER OF CASES WHICH ARE DEALT WITH
Case Is = "MA"
aslinedatafield() = Split(pthelineprocessed, " ")
pdbMass = CDbl(aslinedatafield(2))
End select
End function
Public Property Get TheMass() As Double
TheMass = pdMass
End Property
'in the "main" module
Dim TheDataBlock As New ClDataBlock
For i = 0 to UBound(asdatablock)
TheDataBlock.LineToProcess = asDataBlockLines(5) 'Need to pass argument "MA" as well
dmass = TheDataBlock.TheMass
'and so on for all the data to be extracted
Next i
When a Property has 2 or more arguments, the last argument is what is getting assigned. In other words, the syntax is like this:
TheDataBlock.LineToProcess("MA") = asDataBlockLine(5)
This means you need to change the signature of your property:
Public Property Let LineToProcess(sdataneeded As String, stheline As String)

Array of variables declared as string

I have a query regarding creating an array of variables declared as string.
Below is my code. On debugging, the variables show no value.
Need help..
Module Module1
Public Status, PartStat, HomeStat, ClampStat, SldCylStat, PrsCylP1Stat,
PrsCylP2Stat, PrsCylP3Stat, PrsCylP4Stat, PunchStat, SysInProc, Home1,
Home2, Home3, CyclTim, TrqP1Stat, TrqP2Stat, TrqP3Stat, TrqP4Stat,
AngleP1Stat, AngleP2Stat, AngleP3Stat, AngleP4Stat As String
Function AutoReadStatus()
Dim StatArray = {HomeStat, ClampStat, SldCylStat, Home1, PrsCylP4Stat,
PrsCylP2Stat, Home2, PrsCylP3Stat, PrsCylP1Stat, Home3, PunchStat,
AngleP4Stat, AngleP2Stat, AngleP3Stat, AngleP1Stat, TrqP4Stat,
TrqP2Stat, TrqP3Stat, TrqP1Stat}
Status = ReadMultiReg(FormAuto.SP1, "03", "1258", "0013")
For i = 0 To ((Status.Length / 4) - 1)
StatArray(i) = CInt("&H" & Status.Substring(i * 4, 4))
Next
Return Nothing
End Function
End Module
It is not even showing the index of any variable from above array..
Label1.Text = Array.IndexOf(StatArray, SldCylStat)
When you assign a new value to the item inside the array, you assign a new value to the item inside the array (pun intended).
What that means is that item's array now reference the string (or rather the Integer implicitely converted to string as you don't have Option Strict On) you gave and the precedent reference (on your public field) is dropped.
Test this sample code and I think you will understand
Public item As String
Sub Test()
Dim array = {item}
Console.WriteLine(array(0) Is item) ' True
array(0) = "new value"
Console.WriteLine(array(0) Is item) ' False
End Sub
You can see now array(0) reference another object than the one referenced by the item field
As for how to solve it,yYou could pass all those string ByRef that way assignment inside the method would reflect outside of it but that would be tedious.
A "better" way IMO, would be to make a type (a Class) to hold all those string and pass an instance of that type to your method, that way you just mutate the same existing object.
Quick, contrived example :
Class SomeType
Property Item As String
End Class
Sub Test(instance As SomeType)
instance.Item = "new value"
End Sub
' Usage
Dim sample As New SomeType
' here sample.Item is Nothing
Test(sample)
' here sample.Item is "new value"

VBA - Is it possible to pass an Object's property as an argument in a method?

I'm pretty used to VBA, not that much for Objects though and I'm hitting a wall right now...
My config class has almost 100 properties, so I'll not spam them here as the details doesn't really matter for my question.
I hoped to code a duplicate function, to create multiple objects from one and then assign different values for a specific property of each new objects (add new elements to the configurations, so it generates new configs), that would look like this :
Public Function Duplicate(SrcCfg As Config, PropertyName As String, Properties As String) As Collection
Dim Cc As Collection, _
Cfg As Config, _
TotalNumber As Integer, _
A() As String
Set Cc = New Collection
A = Split(Properties, "/")
TotalNumber = UBound(A)
For i = 0 To TotalNumber
'Create a copy of the source object
Set Cfg = SrcCfg.Copy
'Set the property for that particular copy
Cfg.PropertyName = A(i)
'Add that copy to the collection
Cc.Add ByVal Cfg
Next i
Duplicate = Cc
End Function
But I'm not sure that a collection is the best output (as I'll take the results and incorporate them into another master collection), so I'm open to suggestions.
And I'm pretty sure that we can't pass a Property as an argument (I spent quite some times looking for a solution for this...) and I don't know what to do about it as this would be super practical for me. So if there is a solution or a workaround, I'll gladly try it!
Here is the rest of my methods :
Friend Sub SetConfig(SrcConfig As Config)
Config = SrcConfig
End Sub
Public Function Copy() As Config
Dim Result As Config
Set Result = New Config
Call Result.SetConfig(Config)
Set Copy = Result
End Function
Final code to duplicate object :
Working smoothly :
Private Cfg As Config
Friend Sub SetConfig(SrcConfig As Config)
Set Cfg = SrcConfig
End Sub
Public Function Copy() As Config
Dim Result As Config
Set Result = New Config
Call Result.SetConfig(Cfg)
Set Copy = Result
End Function
Public Function Duplicate(PropertyName As String, Properties As String) As Collection
Dim Cc As Collection, _
Cfg As Config, _
TotalNumber As Integer, _
A() As String
Set Cc = New Collection
A = Split(Properties, "/")
TotalNumber = UBound(A)
For i = 0 To TotalNumber
'Create a copy of the source object
Set Cfg = Me.Copy
'Set the property for that particular copy
CallByName Cfg, PropertyName, VbLet, A(i)
'Add that copy to the collection
Cc.Add Cfg
Next i
Set Duplicate = Cc
End Function
You actually got it right, including the types (String).
Just replace your
Cfg.PropertyName = A(i)
with
CallByName Cfg, PropertyName, vbLet, A(i)
The property name must be passed as a string, not a reference or a lambda or anything, so no type safety or compiler aid here. You will have a runtime error if you misspell the name.
As for the return type, VBA does not have lists, so a collection is generally fine, but because in your particular case you know in advance how many objects you will be returning, you can declare an array:
Dim Cc() As Config
ReDim Cc(1 to TotalNumber)
You could declare an array in any case, but if you didn't know the total number, you'd be reallocating it on every iteration.

How Do I loop through this class once I have added items

How do i loop through this class once I add items via this method. Just I am quite new to generic lists so was wonding if someone could point me in right direction in datatables im used to doing the following:
For Each thisentry In dt.rows
Next
What do I use in collections
Calling Code
Calling this in my delciarations of main class
Dim infoNoProductAvail As List(Of infoProductsNotFound) = New List(Of infoProductsNotFound)()
this is how i am adding the files but I have checked in the routine and the count for the list is at 2 products
If medProductInfo.SKU.SKUID = 0 Then
infoNoProductAvail.Add(New infoProductsNotFound(thisenty2.Item("EAN13").ToString(), True))
End If
this is the class itselfs
Public Class infoProductsNotFound
Public Sub New(tbcode As String, notfound As Boolean)
Me.tagbarcode = tbcode
Me.notfound = notfound
End Sub
Private tagbarcode As String = String.Empty
Private notfound As Boolean
Public Property tbcode() As String
Get
Return tagbarcode
End Get
Set(ByVal value As String)
tagbarcode = value
End Set
End Property
Public Property isNotFound() As Boolean
Get
Return notfound
End Get
Set(ByVal value As Boolean)
notfound = value
End Set
End Property
End Class
Tried
I tried using the following
Function BuildExceptionsForEmail()
Dim retval As String = ""
Dim cnt As Int32 = 0
retval = "The following products are not avialable" & vbCrLf
For Each info As infoProductsNotFound In infoNoProductAvail
retval &= info.tbcode
cnt &= 1
Next
Return retval
but for some reason at this point my info noproductAvail is blank even though in the routine above its sitting at count of 2 what gives?
First I'd shrink that declaration a bit:
Dim infoNoProductAvail As New List(Of infoProductsNotFound)
Next, to iterate there are several options. First (and what you're likely most used to):
For Each info as infoProductsNotFound in infoNoProductAvail
If info.tbCode = "xyz" Then
DoSomething(info)
End If
Next
Or you might want to use lambda expressions (if you're using .Net 3.5 and above I think - might be .Net 4):
infoNoProductAvail.ForEach (Function(item) DoSomething(item))
Remember that generics are strongly typed (unlike the old VB collections) so no need to cast whatever comes out: you can access properties and methods directly.
If infoNoProductAvail(3).isNotFound Then
'Do something
End If
(Not that that is a great example, but you get the idea).
The For Each syntax is the same. It works the same way for all IEnumerable objects. The only "trick" to it is to make sure that your iterator variable is of the correct type, and also to make sure that you are iterating through the correct object.
In the case of the DataTable, you are iterating over it's Rows property. That property is an IEnumerable object containing a list of DataRow objects. Therefore, to iterate through it with For Each, you must use an iterator variable of type DataRow (or one of its base classes, such as Object).
To iterate through a generic List(Of T), the IEnumerable object is the List object itself. You don't need to go to one of it's properties. The type of the iterator needs to match the type of the items in the list:
For Each i As infoProductsNotFound In infoNoProductAvail
' ...
Next
Or:
Dim i As infoProductsNotFound
For Each i In infoNoProductAvail
' ...
Next
Or:
For Each i As Object In infoNoProductAvail
' ...
Next
Etc.

Checking if a value is a member of a list

I have to check a piece of user input against a list of items; if the input is in the list of items, then direct the flow one way. If not, direct the flow to another.
This list is NOT visible on the worksheet itself; it has to be obfuscated under code.
I have thought of two strategies to do this:
Declare as an enum and check if input is part of this enum, although I'm not sure on the syntax for this - do I need to initialise the enum every time I want to use it?
Declare as an array and check if input is part of this array.
I was wondering for VBA which is better in terms of efficiency and readability?
You can run a simple array test as below where you add the words to a single list:
Sub Main1()
arrList = Array("cat", "dog", "dogfish", "mouse")
Debug.Print "dog", Test("dog") 'True
Debug.Print "horse", Test("horse") 'False
End Sub
Function Test(strIn As String) As Boolean
Test = Not (IsError(Application.Match(strIn, arrList, 0)))
End Function
Or if you wanted to do a more detailed search and return a list of sub-string matches for further work then use Filter. This code would return the following via vFilter if looking up dog
dog, dogfish
In this particular case the code then checks for an exact match for dog.
Sub Main2()
arrList = Array("cat", "dog", "dogfish", "mouse")
Debug.Print "dog", Test1("dog")
Debug.Print "horse", Test1("horse")
End Sub
Function Test1(strIn As String) As Boolean
Dim vFilter
Dim lngCnt As Long
vFilter = Filter(arrList, strIn, True)
For lngCnt = 0 To UBound(vFilter)
If vFilter(lngCnt) = strIn Then
Test1 = True
Exit For
End If
Next
End Function
Unlike in .NET languages VBA does not expose Enum as text. It strictly is a number and there is no .ToString() method that would expose the name of the Enum. It's possible to create your own ToString() method and return a String representation of an enum. It's also possible to enumerate an Enum type. Although all is achievable I wouldn't recommend doing it this way as things are overcomplicated for such a single task.
How about you create a Dictionary collection of the items and simply use Exist method and some sort of error handling (or simple if/else statements) to check whether whatever user inputs in the input box exists in your list.
For instance:
Sub Main()
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
myList.Add "item1", 1
myList.Add "item2", 2
myList.Add "item3", 3
Dim userInput As String
userInput = InputBox("Type something:")
If myList.Exists(userInput) Then
MsgBox userInput & " exists in the list"
Else
MsgBox userInput & " does not exist in the list"
End If
End Sub
Note: If you add references to Microsoft Scripting Runtime library you then will be able to use the intelli-sense with the myList object as it would have been early bound replacing
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
with
Dim myList as Dictionary
Set myList = new Dictionary
It's up to you which way you want to go about this and what is more convenient. Note that you don't need to add references if you go with the Late Binding while references are required if you want Early Binding with the intelli-sense.
Just for the sake of readers to be able to visualize the version using Enum let me demonstrate how this mechanism could possibly work
Enum EList
item1
item2
item3
[_Min] = item1
[_Max] = item3
End Enum
Function ToString(eItem As EList) As String
Select Case eItem
Case EList.item1
ToString = "item1"
Case EList.item2
ToString = "item2"
Case EList.item3
ToString = "item3"
End Select
End Function
Function Exists(userInput As String) As Boolean
Dim i As EList
For i = EList.[_Min] To EList.[_Max]
If userInput = ToString(i) Then
Exists = True
Exit Function
End If
Next
Exists = False
End Function
Sub Main()
Dim userInput As String
userInput = InputBox("type something:")
MsgBox Exists(userInput)
End Sub
First you declare your List as Enum. I have added only 3 items for the example to be as simple as possible. [_Min] and [_Max] indicate the minimum value and maximum value of enum (it's possible to tweak this but again, let's keep it simple for now). You declare them both to be able to iterate over your EList.
ToString() method returns a String representation of Enum. Any VBA developer realizes at some point that it's too bad VBA is missing this as a built in feature. Anyway, you've got your own implementation now.
Exists takes whatever userInput stores and while iterating over the Enum EList matches against a String representation of your Enum. It's an overkill because you need to call many methods and loop over the enum to be able to achieve what a simple Dictionary's Exists method does in one go. This is mainly why I wouldn't recommend using Enums for your specific problem.
Then in the end you have the Main sub which simply gathers the input from the user and calls the Exists method. It shows a Message Box with either true or false which indicates if the String exists as an Enum type.
Just use the Select Case with a list:
Select Case entry
Case item1,item2, ite3,item4 ' add up to limit for Case, add more Case if limit exceeded
do stuff for being in the list
Case Else
do stuff for not being in list
End Select