VBScript Class Function with Multiple Parameters - function

I have a class function I want to feed multiple parameters but I am having trouble as I am new to using classes in VB.
This is what I currently have working with a single parameter
Set objLoc = new Location
objLoc.getLoc = strOffice
Need it to work something like this
Set objLoc = new Location
objLoc.getLoc = (strOffice, strDep)
Location Class
Class Location
Private strPhone, strFax, strStreet, strCSZ
Public Property Let getLoc(strOffice)
if LCase(strOffice) = LCase("foo") then
strPhone = "999-999-9999"
strFax = "888-888-8888 fax"
strStreet = "..."
strCSZ = "..."
ElseIf LCase(strOffice) = LCase("bar") then
strPhone = "777-777-7777"
strFax = "555-555-5555 fax"
strStreet = "..."
strCSZ = "..."
Else
End If
End Property
Public Property Get Street
Street = strStreet
End Property
Public Property Get CSZ
CSZ = strCSZ
End Property
Public Property Get Fax
Fax = strFax
End Property
Public Property Get Phone
Phone = strPhone
End Property
End Class

You can't SET a property with more than 1 value, you need a Subroutine to set both OR you need to add a new property for the other value.
So, option #1 (add a sub): (not a vbScript expert but have years of VB.NET and VB:
Public Sub SetOfficeAndDept(office,dept)
... code ...
End Sub
option #2, (add a new property):
Public Property Let Dept(d)
Dept = d
End Property
option #3, (add a new constructor)
Public Sub New(office, dept)
..set your vars...
End Sub
to use it:
Set l = new Location(ofc,dept)

Related

Class to JSON VB.Net

So I have a class which I am serializing to Json. All goes well, until this nested class, which gives me an System.NullReferenceException = {"Object reference not set to an instance of an object."}. When writing the code, intelisense recognizes the nested class, but obviously I'm missing a declaration somewhere.
Root class:
Public Class RootObject
Private _metadata As List(Of Metadata)
Public Property metadata() As List(Of Metadata)
Get
Return _metadata
End Get
Set(ByVal value As List(Of Metadata))
_metadata = value
End Set
End Property
Private _test_gl As List(Of TestGl)
Public Property test_gl() As List(Of TestGl)
Get
Return _test_gl
End Get
Set(ByVal value As List(Of TestGl))
_test_gl = value
End Set
End Property
End Class
Here is the TestGl class definition:
Public Class TestGl
Private _ref_key_3 As String
<JsonProperty("ref-key-3")> _
Public Property ref_key_3() As String
Get
Return _ref_key_3
End Get
Set(ByVal value As String)
_ref_key_3 = value
End Set
End Property
Private _currency_amount As CurrencyAmount
<JsonProperty("currency-amount")> _
Public Property currency_amount() As CurrencyAmount
Get
Return _currency_amount
End Get
Set(ByVal value As CurrencyAmount)
_currency_amount = value
End Set
End Property
End Class
And finally the CurrencyAmount class:
Public Class CurrencyAmount
Private _currency As String
<JsonProperty("currency")> _
Public Property currency() As String
Get
Return _currency
End Get
Set(ByVal value As String)
_currency = value
End Set
End Property
Private _amount As String
<JsonProperty("amount")> _
Public Property amount() As String
Get
Return _amount
End Get
Set(ByVal value As String)
_amount = value
End Set
End Property
End Class
Here follow the code of filling up the object with data:
Dim Root As RootObject
Dim Meta_Data As New List(Of Metadata)()
Dim Test_Gl As New List(Of TestGl)()
Root = New RootObject
Root.metadata = New List(Of Metadata)()
Root.test_gl = New List(Of TestGl)
Meta_Data = Root.metadata
Test_Gl = Root.test_gl
And here I assign values to it:
Test_Gl.Add(New AccountGl)
Test_Gl(ItemNo).ref_key_3 = "test"
Test_Gl(ItemNo).currency_amount.currency = "EUR"
Test_Gl(ItemNo).currency_amount.amount = "100"
The line where currency_amount.currency gets assigned, it goes wrong and I'm looking at it for several hours already. I don't see it.
Any input would be highly appreciated.
The properties are written in full as I need to work on this project in VS2008.
I suspect somewhere you need to initialize _currency_amount to a new instance of CurrencyAmount I don't see new CurrencyAmount anywhere.
I suspect that you don't really want to allow the currency_amount property to be set, otherwise you should have set it in your sample assignment code at the bottom. If this is the case, then you probably shouldn't even have a Set member defined for TestGl (it should be ReadOnly, which affects only currency_amount and not _currency_amount.currency). Instead you should create a default instance of CurrencyAmount and assign it to that field during the construction of TestGl. That could be as simple as changing your declaration of _currency_amount to:
Private _currency_amount As New CurrencyAmount
Alternatively, and this may be the solution you need to use with a JSON serializable object, you keep the Set member definition, and just add a line to your test code to initialize currency_amount before using it:
Test_Gl(ItemNo).currency_amount = new CurrencyAmount

VBA - Nested Class

[Edited the code]
Sorry for newbie question. I was trying to test nested classes in VBA for Excel but got error message. Can anyone help me understand why? Thank you!
Inside class:
' CLASS MODULE - cInside
' Member variables
Private m_Value As Integer
' Properties
Property Get Value() As Integer
Value = m_Value
End Property
Property Let Value(i As Integer)
m_Value = i
End Property
' Methods
Sub init()
m_Value = 0
End Sub
Sub Inc()
m_Value = m_Value + 1
End Sub
Outside class:
' CLASS MODULE - cOutside
' Member variables
Private m_Num1 As New cInside
Private m_Num2 As New cInside
' Properties
Property Get Num1() As cInside
Num1 = m_Num1.Value
End Property
Property Get Num2() As cInside
Num2 = m_Num2.Value
End Property
Property Set Num1(i As cInside)
Set m_Num1 = i
End Property
Property Set Num2(i As cInside)
Set m_Num2 = i
End Property
Main program:
Sub Main()
Dim o As New cOutside
Dim i As New cInside
i.Value = 9
i.Inc
Debug.Print i.Value '<-- this works
Set o.Num1 = i
o.Num1.Inc '<-- object variable or with block variable not set
Debug.Print (o.Num1.Value)
End Sub
Thank you again!
n.Num1 returns an Integer, which isn't an instance of cInside, and therefore doesn't have an Inc member, which makes it an invalid qualifier for the compiler to complain about ;-)
Your cOutside class needs to expose it somehow:
Property Get ComposedObject1() As cInside
Set ComposedObject1 = m_Num1
End Property
Then the calling code could do this:
n.ComposedObject1.Inc
I called that "composed", because what you're doing isn't "nesting", but "composition". VBA doesn't supported nested classes, which would be a class module defined inside another class module, like so:
Class Outside
'... members...
Class Inside
'...members...
End Class
End Class
VB.NET can do that, but in VBA 1 class module can only define 1 class.

New to classes VBA Access

I have been working on a project and have multiple tick boxes (25) and multiple labels in a form that are names SC1, SC2...SCN and Lbl1, Lbl2...LblN depending on a recordset. When I click the tickbox I want the label beside it to display some information, see below -
Private Sub SC1_Click()
If (Me!SC1) = True Then
Form.Controls("Lbl1").Caption = ("Completed by " & (Environ$("Username")))
Form.Controls("Lbl1").ForeColor = vbGreen
Else
Form.Controls("Lbl1").Caption = ("Please tick if Complete")
Form.Controls("Lbl1").ForeColor = vbBlack
End If
End Sub
My issue is I can't change the number in the Sub name so I would have to create multiple sub procedures. I think if I created a class for the tick box this would change but I am not sure how I can set up the class. I have tried the below class template but am not sure where I can change the property values in order to reach my goal. I am not sure why you would have both get and set properties in one class. Any help on this is greatly appreciated.
Option Compare Database
Option Explicit
Private pName As String
Private pCaption As String
Private pVisiblity As Boolean
Private pValue As Boolean
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Value As String)
pName = Value
End Property
Public Property Get Caption() As String
Caption = pCaption
End Property
Public Property Let Caption(Value As String)
pCaption = "Please Tick Box if complete"
End Property
Public Property Get Visibility() As Boolean
Visibility = pVisibility
End Property
Public Property Let Visibility(Value As Boolean)
pVisibility = True
End Property
Public Property Get Value() As Boolean
Value = pValue
End Property
Public Property Let Value(Value As Boolean)
pValue = True
End Property
There are two parts to creating and linking form controls to custom support objects (classes). In your case
Class Module: clsMyCheckbox
Option Explicit
Option Compare Database
Public WithEvents chkBox As CheckBox
Public chkLabel As Label
Private currentUser As String
Private Sub chkBox_Click()
If chkBox.Value = True Then
chkLabel.Caption = "Completed by " & currentUser
chkLabel.ForeColor = vbGreen
Else
chkLabel.Caption = "Please tick if Complete"
chkLabel.ForeColor = vbBlack
End If
End Sub
Private Sub Class_Initialize()
currentUser = Environ$("Username")
End Sub
And in your form module:
Option Explicit
Option Compare Database
Private localCheckboxes As New Collection
Private Sub Form_Load()
'--- find all the checkboxes on the form and create a
' handler object for each one
Dim ctl As Control
Dim chknum As String
Dim cbObj As clsMyCheckbox
Dim chkLbl As Label
For Each ctl In Me.Controls
If ctl.ControlType = acCheckBox Then
'--- you can filter by name if needed
If ctl.Name Like "SC*" Then
chknum = Right(ctl.Name, Len(ctl.Name) - 2)
Set chkLbl = Me.Controls.Item("Lbl" & chknum)
chkLbl.Caption = "initialized" 'optional during form load
Set cbObj = New clsMyCheckbox 'class object for this checkbox
Set cbObj.chkBox = ctl 'link the control to the object
Set cbObj.chkLabel = chkLbl 'link the label too
'--- add it to a local store so the object persists
' as long as the form is open
localCheckboxes.Add cbObj
End If
End If
Next ctl
End Sub
Private Sub Form_Unload(Cancel As Integer)
'--- guarantee the objects are destroyed with the form
Set localCheckboxes = Nothing
End Sub
I think you are going the wrong way. In Access you can't really derive your own classes for GUI control and use them on the form. For your problem, you basically have three options:
Use the default event handlers and call one custom function from each. This will improve your situation a little.
Use one custom event handler for all checkboxes, instead of the default event-handlers.
Use a class and attach an instance to each of the checkboxes you use. The class can then recieve any event from the checkbox. This is powerful but you will still need to register your class with each control and hold all you instances somewhere for this to work.
For your problem, I'd go with solution 2:
First, write a custom event handler like this in your Form-module:
Private Function chkClick(sName As String)
Debug.Print "Clicked: " & sName
Me.Controls(sName).Controls(0).Caption = "x"
End Function
Next, enter design mode of you form and go to all checkboxes. In Checkbox "SC1", you go to the "OnClick" event and enter =chkClick("SC1") as event handler instead of [Eventprocedure]. Make sure you use the correct name of the control as the parameter of the function.
Congratulations! From now on, all your checkboxes will call the same event-handler and pass their name. Since the label of a checkbox is its associated control, you get to that label from the checkbox via .Controls(0), meaning the first "sub"-control of the checkbox. This way, you don't need to know the name of the associated label at all!

ServiceStack.Text reading json results not working

I am just trying to figure out the best way to deserialize a json string returned from a 3rd party api call. I read ServiceStack is fast so want to try it out. No experience and here is what I have done:
Opened Visual Studio 2013
Created new project Windows Forms Application
Installed ServiceStack.Text (based on https://servicestack.net/download)
Added a button (btnView) and textbox (txtOutput)
Add code to btnView_Click event
Private Sub btnView_Click(sender As Object, e As EventArgs) Handles btnView.Click
Me.Cursor = Cursors.WaitCursor
Dim wp As New WebPost 'this allows to pass url and return results
wp.URL = "xxxx"
Dim sJSONRetVal As String = wp.Request(String.Empty, True)
'sJSONRetVal return values looks like the following:
'{"complaints":[{"feedback_type":"abuse","subject":"Sales Agent Position"},{"feedback_type":"abuse","subject":"Sales Agent Position"}],"message":"OK","code":0}
'ServiceStack.Text example
Dim t As SMTP_Complaints = ServiceStack.Text.JsonSerializer.DeserializeFromString(Of SMTP_Complaints)(sJSONRetVal)
'For Each xi As SMTP_Complaints In t
' txtOutput.Text &= xi.mail_from & vbCrLf
'Next
wp = Nothing
txtOutput.Text = t.ToString
Me.Cursor = Cursors.Default
End Sub
Public Class SMTP_Complaints
Dim _feedback_type As String = ""
Dim _subject As String = ""
Public Property feedback_type As String
Get
Return _feedback_type
End Get
Set(value As String)
_feedback_type = value
End Set
End Property
Public Property subject As String
Get
Return _subject
End Get
Set(value As String)
_subject = value
End Set
End Property
End Class
The above doesn't seem to get any data. how would I loop through the data returned and return the data from both instances? Just not sure how I need to set this up to read the json data and then be able to output.
Based on the returned JSON of:
{"complaints":[{"feedback_type":"abuse","subject":"Sales Agent Position"},{"feedback_type":"abuse","subject":"Sales Agent Position"}],"message":"OK","code":0}
You will need two DTOs to deserialise this result.
I have used auto implemented properties here to simplify the complexity of the code. If you use an older version of VB, you'll need to expand these out to include a backing field with get and set method.
Public Class SMTP_Complaint
Public Property feedback_type As String
Public Property subject As String
End Class
Public Class SMTP_ComplaintsResponse
Public Property complaints As SMTP_Complaint()
Public Property message As String
Public Property code As Integer
End Class
You need the SMTP_ComplaintsResponse class because your complaints are wrapped in your JSON response.
Then to deserialise the response:
Dim response = JsonSerializer.DeserializeFromString(Of SMTP_ComplaintsResponse)(sJSONRetVal)
And your complaints are then accessible:
For Each complaint As var In response.complaints
Console.WriteLine("Type: {0}, Subject {1}", complaint.feedback_type, complaint.subject)
Next

VBA MS Access 2010 How to call a Subroutine of an Object?

I've been trying to create a Subroutine in VBA for my Access application:
Public Sub addProduct(ByRef Product As Product, AsFoo As Integer, Optional Mutual As Boolean = True)
Products.Add (Product)
If (Mutual) Then
Select Case AsFoo
Case 0
Product.setProjectmanager = Me
Case 1
Product.setVIP1 = Me
Case 2
Product.setVIP2 = Me
Case 11
Product.setVIP1A = Me
Case 22
Product.setVIP2A = Me
End Select
End If
End Sub
That one should just add the given Product to a Collection of Products and set the reference to the User reference, if Mutual is true.
That one should work... the problem is that I don't know how to call that
my current try is:
User.addProduct(Product, 0, True)
But the IDE wants to have a = at the end so I thought that would work:
User.addProduct(Product, 0, True) = Product
But that causes a Compile Error:
Expected function or Variable
Try calling that line with:
User.addProduct Product, 0, True
or
Call User.addProduct(Product, 0, True)
Removing the () or using the Call keyword should work for you.
I'm not sure if this is what you want to do, but if it is adding class instances to a collection, I propose something like this:
Sub Main_sub()
dim colProduct as Collection
dim cProduct as clsProduct
dim asFoo as integer
dim Mutual as boolean
set colProduct = new collection
set cProduct = new clsproduct
asFoo = ? 'Define
Mutual = ? 'Define
'if the AddProduct function resides in the clsProduct class:
set cProduct = cproduct.AddProduct(cProduct, asFoo, Mutual)
colProduct.add cProduct
set cProduct = nothing
set colProduct = nothing
end sub
And for private Product class properties Projectmanager, VIP1, VIP2, VIP1A,VIP2A
Public function addProduct(cProduct as clsProduct, AsFoo As Integer, Optional Mutual As Boolean) as cProduct
If (Mutual) Then
Select Case AsFoo
Case 0
cProduct.Projectmanager = Me
Case 1
cProduct.VIP1 = Me
Case 2
cProduct.VIP2 = Me
Case 11
cProduct.VIP1A = Me
Case 22
cProduct.VIP2A = Me
End Select
End If
set addProduct = cProduct
End Sub
You declare properties in a class module this way:
Private pVIP1 as <Type>
And getters / setters:
Public Property Get VIP1() As <Type>
VIP1 = pVIP1
End Property
Public Property Let VIP1(tVIP1 As <Type>)
pVIP1 = tVIP1
End Property
If the type is an object, you need to use SET instead of LET.
Public Property SET VIP1(tVIP1 As <Type>)
SET pVIP1 = tVIP1
End Property
Maybe I've got your intentions wrong, because I don't see the purpose of adding Me to each of the cases. But this was the best I could come up with.