How can I see what properties an element has in a VB script? Example:
Dim list : Set list = CreateObject( "Scripting.Dictionary" )
' ... Fill List ...
WriteListElements list
...
Sub WriteListElements ( list )
Dim e, le
For Each e In list
Set le = list(e) ' what properties does le have?
le.name_of_user_defined_attribut ' I want to access a property but dont know the exact name
Next
End Sub
I use a Tool with a VBScript API. In that API I can read (user defined) attributes from that Tool. But while running the script I get an error telling me that it does not know the name of that user defined attribut. But I use it in the tool. Now I would like to know which attributes are availble in the array above to see if the user defined attributes are named specificly.
Not really possible. Only very basic type information is available in the VBScript runtime. Ideally you could create an adapter that translates your tool's objects into standard Dictionary objects and iterate the Keys. If that's not possible, the best you can do is check the type name for each object before invoking its members. Example:
<html>
<body>
<script type="text/vbscript">
Class Human
Private m_name
Public Property Get Name
Name = m_name
End Property
Public Property Let Name(newName)
m_name = newName
End Property
End Class
Dim joe
Set joe = new Human
joe.Name = "Joe Coder"
Dim list
Set list = CreateObject( "Scripting.Dictionary" )
list.Add "a", 5
list.Add "b", joe
list.Add "c", "apples"
WriteListElements list
Sub WriteListElements ( list )
Dim e
For Each e In list
If (TypeName(list.Item(e)) = "Human") Then
document.write("We have found a Human: " &_
"<b>" & list.Item(e).Name & "</b>")
End If
Next
End Sub
</script>
</body>
</html>
Will you be able to get the list of properties from a script like this?
http://www.vbsedit.com/scripts/misc/wmi/scr_1332.asp
And, you can then use eval() or execute to get the values of these properties.
Dim list : Set list = CreateObject( "Scripting.Dictionary" )
' ... Fill List ...
WriteListElements list
...
Sub WriteListElements ( list )
Dim e, le
For Each e In list
Set le = e.Items
Response.Write le(name_of_user_defined_attribut)
Next
End Sub
It is easy - use a pseudo reflection:
class Developer
Public reflection
'=============================
'Private properties
private mId
private mFirstName
private mLastName
private sub Class_Initialize()
reflection = Array("Id","FirstName","LastName")
end sub
private sub Class_Terminate()
end sub
'=============================
'public properties
public property get Id()
Id = mId
end property
public property let Id(val)
mId = val
end property
public property get FirstName()
FirstName = mFirstName
end property
public property let FirstName(val)
mFirstName = val
end property
public property get LastName()
LastName = mLastName
end property
public property let LastName(val)
mLastName = val
end property
end class
For each property in obj.reflection
document.write(property)
document.write( Eval ("obj." & property) )
Next
Related
I have a class ClsAnimal containing the string property species, and also method plural which just returns a string with added "s" at the end of a string. I wonder if it's possible to apply .Plural to Animal.Species directly, as shown in the example below:
Sub Test()
Dim Animal As New ClsAnimal
Animal.Species = "cat"
debug.print Animal.Species
'expected result "cat"
debug.print Animal.Species.Plural
'expected result "cats"
End Sub
ClsAnimal Code:
Option Explicit
Private PSpecies As String
Property Let Species(val As String)
PSpecies = val
End Property
Property Get Species() As String
Species = PSpecies
End Property
'returns the name of an animal + "s"
Private Function Plural(val) As String
Plural = val & "s"
End Function
You can kind of hack your way to the behavior you are describing. They way I could implement this is to create a new class that "extends" strings. I've called mine StringExt and it looks like this:
Option Explicit
Private pValue As String
'#DefaultMember
Public Property Get Value() As String
Value = pValue
End Property
Public Property Let Value(val As String)
pValue = val
End Property
Public Function Pluralize() As String
Dim suffix As String
'Examine last letter of the string value...
Select Case LCase(Right(pValue, 1))
Case "" 'empty string
suffix = ""
Case "s" 'words that end in s are pluralized by "es"
suffix = "es"
'Test for any other special cases you want...
Case Else ' default case
suffix = "s"
End Select
Pluralize = pValue & suffix
End Function
This is a wrapper class that wraps around an inner string value. It has a single method which will try to return the plural of the inner string value. One thing to note here is the use of a DefaultMember. I used a really handy vba editor COM addin called RubberDuck to do all the behind-the-scenes work for me with the Default Member. You can do it manually though. You would need to export the class module and modify it in a text editor, adding the Attribute Value.VB_UserMemId = 0 tag inside the property getter:
...
Public Property Get Value() As String
Attribute Value.VB_UserMemId = 0
Value = pValue
End Property
Public Property Let Value(val As String)
pValue = val
End Property
...
Then, import the module back into your vba project. This attribute is not visible in the vba editor. More on default members here but it basically means this property will be returned if no property is specified.
Next, we change up your animal class a bit, using our new StringExt type for the Species property:
Option Explicit
Private pSpecies As StringExt
Public Property Set Species(val As StringExt)
pSpecies = val
End Property
Public Property Get Species() As StringExt
Set Species = pSpecies
End Property
Private Sub Class_Initialize()
Set pSpecies = New StringExt
End Sub
Note here that you'll now need to make sure the pSpecies field gets instantiated since it is an object type now. I do this in the class Initializer to enure it always happens.
Now, your client code should work as expected.
Sub ClientCode()
Dim myAnimal As Animal
Set myAnimal = New Animal
myAnimal.Species = ""
Debug.Print myAnimal.Species.Pluralize
End Sub
Disclamer:
Substituting a basic string type for an object type might cause unexpected behavior in certain fringe situations. You are probably better off just using some global string helper method that takes a string parameter and returns the plural version. But, my implementation will get the behavior you asked for in this question. :-)
Is there a way in VBA to query a collection of custom classes named People. Lets say I have a custom class that has First Name, Last Name, and Title.
‘private attributes
Private pFirstName as String
Private pLastName as String
Private pTitle as String
‘Get/Let Methods
Public Property Get FirstName() as String
FirstName = pFirstName
End Property
Public Property Let FirstName (Value as String)
pFirstName = Value
End Property
Public Property Get LastName() as String
LastName = pLastName
End Property
Public Property Let LastName(Value as String)
pLastName = Value
End Property
Public Property Get Title() as String
Title = pTitle
End Property
Public Property Title Let (Value as String)
pTitle = Value
End Property
I then, in my main SUB, create a collection of people. Is there a way to query that collection, Ie, return me all People with first name == Jack.
Thanks
You could go out of your way to implement something like this so you could do crazy stuff like:
Dim items As LinqEnumerable
Set items = LinqEnumerable.FromCollection(myCollection) _
.Where("x => x.FirstName = ""Jack""")
Dim p As Person '"People" is plural, you don't want a pluralized class name here.
For Each p In items
Debug.Print p.FirstName
Next
But that is very very much overkill, and inefficient. All you need is one loop, and a condition:
For Each p In myCollection
If p.FirstName = "Jack" Then
'we have a winner
End If
Next
I'm new to using VBA classes, and I think what I want to do -- using them with ListObjects -- is more of an "intermediate" than "beginner" technique.
Let's say I have two tables related to cars.
tblCarDesc
ID MAKE MODEL DOORS ENGINE
1 Chevrolet Corvette 2 V8
2 Ford Escort 4 V6
3 Rolls-Royce SilverCloud 4 V8
tblCarProd
ID COUNTRY TYPE
1 US Sport
2 US Economy
3 UK Luxury
(The same cars are in both tables, and shown by the ID numbers.)
I want to have a class called objCars that includes the fields (columns) from both tables. That way, when referring to Car #3, objCars.Make would be "Rolls-Royce" and objCars.Type would be "Luxury".
1) Is there a way to import both tables into objCars?
Perhaps I would create an array big enough to hold all the columns, then load both tables into it. The tutorial I've been reading says that I would then create a Collection, loop through each row of the array, make a new instance of objCars, and assign objCars.Make, objCars.Model, etc., for each row. Then each item of the Collection would contain a car. (Or something like that. I don't really know much about Collections either.) If that's right, is it the best way?
2) How exactly does one refer to a specific car? The examples I've read like to loop through Collections and work on each item therein, but what if I want to extract a particular item? I know the Ford is Car #2; how do I get the objCars.Make and objCars.Model for that particular ID number?
I would have two classes. A class clsCar for one car and a class clsCars for a collection of cars.
Each of this classes may have setter and getter methods and also may have custom methods if needed. Especially the clsCars should have a set of getBy...-methods to get a car or a collection of cars from the collection by criterion.
Example:
clsCar:
Private pID As Long
Private pMAKE As String
Private pMODEL As String
Private pDOORS As Integer
Private pENGINE As String
Private pCOUNTRY As String
Private pTYPE As String
Public Property Get ID() As Long
ID = pID
End Property
Public Property Let ID(Value As Long)
pID = Value
End Property
Public Property Get MAKE() As String
MAKE = pMAKE
End Property
Public Property Let MAKE(Value As String)
pMAKE = Value
End Property
Public Property Get MODEL() As String
MODEL = pMODEL
End Property
Public Property Let MODEL(Value As String)
pMODEL = Value
End Property
Public Property Get DOORS() As Integer
DOORS = pDOORS
End Property
Public Property Let DOORS(Value As Integer)
pDOORS = Value
End Property
Public Property Get ENGINE() As String
ENGINE = pENGINE
End Property
Public Property Let ENGINE(Value As String)
pENGINE = Value
End Property
Public Property Get COUNTRY() As String
COUNTRY = pCOUNTRY
End Property
Public Property Let COUNTRY(Value As String)
pCOUNTRY = Value
End Property
Public Property Get CarTYPE() As String
CarTYPE = pTYPE
End Property
Public Property Let CarTYPE(Value As String)
pTYPE = Value
End Property
Public Function toString() As String
toString = pID & "; " & _
pMAKE & "; " & _
pMODEL & "; " & _
pDOORS & "; " & _
pENGINE & "; " & _
pCOUNTRY & "; " & _
pTYPE
End Function
clsCars:
Private pCars As collection
Private Sub Class_Initialize()
Set pCars = New collection
End Sub
Public Sub add(oCar As clsCar)
pCars.add oCar
End Sub
Public Function getByIndex(lIndex As Long) As clsCar
Set getByIndex = pCars.Item(lIndex)
End Function
Public Function getByID(lID As Long) As clsCar
Dim oCar As clsCar
For Each oCar In pCars
If oCar.ID = lID Then
Set getByID = oCar
End If
Next
End Function
Public Function getByEngine(sEngine As String) As collection
Dim oCar As clsCar
Set getByEngine = New collection
For Each oCar In pCars
If oCar.ENGINE = sEngine Then
getByEngine.add oCar
End If
Next
End Function
default Module:
Public oCars As clsCars
Sub initialize()
Dim oCar As clsCar
Dim oListObject As ListObject
Dim oListRow As ListRow
Dim oCells As Range
Set oCars = New clsCars
Set oListObject = Worksheets("Sheet1").ListObjects("tblCarDesc")
For Each oListRow In oListObject.ListRows
Set oCells = oListRow.Range.Cells
Set oCar = New clsCar
oCar.ID = oCells(, 1).Value
oCar.MAKE = oCells(, 2).Value
oCar.MODEL = oCells(, 3).Value
oCar.DOORS = oCells(, 4).Value
oCar.ENGINE = oCells(, 5).Value
oCars.add oCar
Next
Set oListObject = Worksheets("Sheet1").ListObjects("tblCarProd")
Dim lID As Long
For Each oListRow In oListObject.ListRows
Set oCells = oListRow.Range.Cells
lID = oCells(, 1).Value
Set oCar = oCars.getByID(lID)
If Not oCar Is Nothing Then
oCar.COUNTRY = oCells(, 2).Value
oCar.CarTYPE = oCells(, 3).Value
End If
Next
MsgBox oCars.getByIndex(2).toString
For Each oCar In oCars.getByEngine("V8")
MsgBox oCar.toString
Next
End Sub
I would use a class for each, and an array of each also, so arrCars holds clsCars, and arrProd holds clsProduction. I would then use the index of each for each array when populating, so arrCars(1)=Corvette and arrProd(1)=US Sport then from each you can refer to the others, so if x=3, cars(x) and prod(x) will be correct. Or use a vlookup in excel first, and make one larger table, with the need for only 1 ID then, if that is the way they are related, but can a Bentley also be 3. Its not quite clear what you mean by the 2nd table, is there an entry for each car, or is it like catgeorising the car further, just using a certain selection. Another idea would be to have an extra property in the car class, of ProductionID and then use a static production "table" of classes to refer to.
Ok to start off, I read through this.
It is close although it doesn't answer my specific question. This talks about taking smaller collections and adding items to a larger main collection. Then destroying the smaller collection.
I have two definitions under Class Modules.
TimeDet
Option Explicit
Public recDate As String
Public recQty As String
Public recDieNo As String
Public recCatID As String
Public recCatName As String
Public recGroupID As String
Public recGroupName As String
TimeRec
Option Explicit
Private objTimeRec As Collection
Private Sub Class_Initialize()
Set objTimeRec = New Collection
End Sub
Private Sub Class_Terminate()
Set objTimeRec = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = objTimeRec.[_NewEnum]
End Property
Public Sub Add(obj As TimeDet)
objTimeRec.Add obj
End Sub
Public Sub Remove(Index As Variant)
objTimeRec.Remove Index
End Sub
Public Property Get Item(Index As Variant) As TimeDet
Set Item = objTimeRec.Item(Index)
End Property
Property Get Count() As Long
Count = objTimeRec.Count
End Property
Public Sub Clear()
Set objTimeRec = New Collection
End Sub
Public Sub FillFromArray(Arr As Variant)
Dim i As Long, obj As TimeDet
For i = 1 To UBound(Arr)
Set obj = New TimeDet
obj.recDate = Arr(i, 1)
obj.recQty = Arr(i, 2)
obj.recDieNo = Arr(i, 3)
obj.recCatID = Arr(i, 4)
obj.recCatName = Arr(i, 5)
obj.recGroupID = Arr(i, 6)
obj.recGroupName = Arr(i, 7)
Me.Add obj
Next
End Sub
Then in the code I am using it this way:
Sub Test()
Dim RecSet1 As TimeRec, Record As TimeDet
Dim fSet1 As TimeRec, fRecord As TimeDet
Dim repArray() As Variant
Dim startDT As Date, endDT As Date, dieNo As String
repArray() = Sheet4.Range("A2:G" & Sheet4.Range("A2").End(xlDown).Row)
Set RecSet1 = New TimeRec
Set fSet1 = New TimeRec
RecSet1.FillFromArray (repArray())
startDT = "1-1-2015"
endDT = "1-1-2016"
dieNo = "16185"
For Each Record In RecSet1
If Record.recDate <= endDT And Record.recDate >= startDT And Record.recDieNo = dieNo Then
fSet1.Add (Record)
End If
Next
End Sub
I am getting an error when I try to add the Record object to the fSet1 object.
"Object doesn't support this method or property"
The Record object is Type TimeDet which as you can see up in the class module my Add method is expecting type TimeDet.
Either I am missing something very simple and have blinders on, or this is a bigger issue.
The array has 200,000 records roughly. I am attempting to create a smaller subset of filtered data. Maybe I am approaching this from the wrong way.
Your error is not at Add but at For Each
Most likely you copied your TimeRec Class. In VBA, you can't create enumerable classes inside the VBE (VBA IDE). There's a different way of creating Enumerable classes.
Open a notepad, copy all your class code and then add this attribute to NewEnum property Attribute NewEnum.VB_UserMemId = -4
Then import the class.
This is always hidden in VBA code, but can be seen in text editors.
Also add this attribute to Item property, it will make it default and allows syntax like ClassName(1)
Attribute Item.VB_UserMemId = 0
So , your code in text editor/ notepad should be:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private objTimeRec As Collection
Private Sub Class_Initialize()
Set objTimeRec = New Collection
End Sub
Private Sub Class_Terminate()
Set objTimeRec = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = objTimeRec.[_NewEnum]
End Property
Public Sub Add(obj As Class2)
objTimeRec.Add obj
End Sub
Public Sub Remove(Index As Variant)
objTimeRec.Remove Index
End Sub
Public Property Get Item(Index As Variant) As Class2
Attribute Item.VB_UserMemId = 0
Set Item = objTimeRec.Item(Index)
End Property
Property Get Count() As Long
Count = objTimeRec.Count
End Property
Public Sub Clear()
Set objTimeRec = New Collection
End Sub
The answer to this particular problem was to remove the parenthesis form my Add method. That being said, the attribute info being hidden was really good info and would have probably contributed to the problem after I figured out that removing the parenthesis fixed it.
How can I get the name of the object that was passed byref into a method?
Example:
Dim myobject as object
sub mymethod(byref o as object)
debug.print(o.[RealName!!!!])
end sub
sub main()
mymethod(myobject)
'outputs "myobject" NOT "o"
end sub
I'm using this for logging. I use one method multiple times and it would be nice to log the name of the variable that I passed to it. Since I'm passing it byref, I should be able to get this name, right?
For minitech who provided the answer:
This would give you the parameter name in the method and it's type, but not the name of the variable that was passed byref.
using system.reflection
Dim mb As MethodBase = MethodInfo.GetCurrentMethod()
For Each pi As ParameterInfo In mb.GetParameters()
Debug.Print("Parameter: Type={0}, Name={1}", pi.ParameterType, pi.Name)
Next
If you put that in "mymethod" above you'd get "o" and "Object".
That's impossible. Names of variables are not stored in IL, only names of class members or namespace classes. Passing it by reference makes absolutely zero difference. You wouldn't even be able to get it to print out "o".
Besides, why would you ever want to do that?
Alternatively you could get the 'Type' of the object using reflection.
Example: (Use LinqPad to execute)
Sub Main
Dim myDate As DateTime = DateTime.Now
MyMethod(myDate)
Dim something As New Something
MyMethod(something)
End Sub
Public Class Something
Public Sub New
Me.MyProperty = "Hello"
End Sub
Public Property MyProperty As String
End Class
Sub MyMethod(Byref o As Object)
o.GetType().Name.Dump()
End Sub
Sorry to say, but this is your solution. I left (ByVal o As Object) in the method signature in case you're doing more with it.
Sub MyMethod(ByVal o As Object, ByVal name As String)
Debug.Print(name)
End Sub
Sub Main()
MyMethod(MyObject, "MyObject")
End Sub
Alternatively you could create an interface, but this would only allow you to use MyMethod with classes you design. You can probably do more to improve it, but as this code stands you can only set the RealName at creation.
Interface INamedObject
Public ReadOnly Property RealName As String
End Interface
Class MyClass
Implements INamedObject
Public Sub New(ByVal RealName As String)
_RealName = RealName
End Sub
Private ReadOnly Property RealName As String Implements INamedObject.RealName
Get
Return _RealName
End Get
End Property
Private _RealName As String
End Class
Module Main
Sub MyMethod(ByVal o As INamedObject)
Debug.Print(o.RealName)
End Sub
Sub Main()
Dim MyObject As New MyClass("MyObject")
MyMethod(MyObject)
End Sub
End Module
If your program is still in the same place relative to the code that made it, this may work:
' First get the Stack Trace, depth is how far up the calling tree you want to go
Dim stackTrace As String = Environment.StackTrace
Dim depth As Integer = 4
' Next parse out the location of the code
Dim delim As Char() = {vbCr, vbLf}
Dim traceLine As String() = stackTrace.Split(delim, StringSplitOptions.RemoveEmptyEntries)
Dim filePath As String = Regex.Replace(traceLine(depth), "^[^)]+\) in ", "")
filePath = Regex.Replace(filePath, ":line [0-9]+$", "")
Dim lineNumber As String = Regex.Replace(traceLine(depth), "^.*:line ", "")
' Now read the file
Dim program As String = __.GetStringFromFile(filePath, "")
' Next parse out the line from the class file
Dim codeLine As String() = program.Split(delim)
Dim originLine As String = codeLine(lineNumber * 2 - 2)
' Now get the name of the method doing the calling, it will be one level shallower
Dim methodLine As String = Regex.Replace(traceLine(depth - 1), "^ at ", "")
Dim methodName = Regex.Replace(methodLine, "\(.*\).*$", "")
methodName = Regex.Replace(methodName, "^.*\.", "")
' And parse out the variables from the method
Dim variables As String = Regex.Replace(originLine, "^.*" & methodName & "\(", "")
variables = Regex.Replace(variables, "\).*$", "")
You control the depth that this digs into the stack trace with the depth parameter. 4 works for my needs. You might need to use a 1 2 or 3.
This is the apparently how Visual Basic controls handle the problem.
They have a base control class that in addition to any other common properties these controls may have has a name property.
For Example:
Public MustInherit Class NamedBase
Public name As String
End Class
Public Class MyNamedType
Inherits NamedBase
public Value1 as string
public Value2 as Integer
End Class
dim x as New MyNamedType
x.name = "x"
x.Value1 = "Hello, This variable is name 'x'."
x.Value2 = 75
MySubroutine(x)
public sub MySubroutine(y as MyNamedType)
debug.print("My variable's name is: " & y.name)
end sub
The output in the intermediate window should be:
My variable's name is: x