VBA dictionary as a property of a class - vba

I have this simplified class named clsWarehouseSum.
Option Compare Database
Option Explicit
Private wh_units As Scripting.Dictionary
Public Function availableUnits(warehouse As String) As Long
'Debug.Print wh_units(warehouse)
If wh_units Is Nothing Then Set wh_units = New Scripting.Dictionary
If Not wh_units.Exists(warehouse) Then
Dim SQL As String
Dim RS As DAO.Recordset
SQL = "SELECT sum(units) as tot_units " _
& "FROM warehouse " _
& "WHERE warehouse = '" & warehouse & "' "
Set RS = CurrentDb.OpenRecordset(SQL)
wh_units.Add (warehouse), RS("tot_units")
End If
availableUnits = wh_units(warehouse)
End Function
I try to use it like this:
Sub test()
Dim wh As New clsWarehouseSum
Debug.Print wh.availableUnits("Cohasset")
Debug.Print wh.availableUnits("Cohasset")
End Sub
While the first Debug.Print prints what's expected, the second one gives me an error:
Run time error 3420, Object Invalid or no longer set. When I step through the code, it correctly evaluates both if statements as false. Yet, the last line of the function gives me the error mentioned above. What am I doing wrong?
Why?

Add Debug.Print TypeName(wh_units(warehouse)) before the availableUnits = wh_units(warehouse) line and if it prints anything else than Long to the Immediate window then you might want to cast to Long using CLng while you also have some error handler in place.
Or, you might want to make sure that the line wh_units.Add (warehouse), RS("tot_units") is adding a Long to your dictionary so you should check the type before you add.
As a general rule, when you return a specific data type from a dictionary or collection, you should always have checks in place either when you add the data to the dict/coll or when you return it so that you avoid type incompatibility and runtime errors.

Related

Make pre-prepared sql command in libreoffice basic

I'm trying to make a prepared query based on the value in a field in my form in libreoffice basic.For this, I created a macro.
But it returns an error on the query line saying
BASIC syntax error.
Unexpected symbol: oInstruction_SQL
Sub concatMotherName
Dim oSourceDonnees As Object
Dim oConnexion As Object
Dim stSql As String
Dim oResultat As Object
oSourceDonnees = thisComponent.Parent.dataSource
oConnexion = oSourceDonnees.getConnection("","")
oInstruction_SQL = oConnexion.createStatement()
Dim valueData As String
Dim dateLabel As String
valueData = ThisComponent.Drawpage.Forms.getByName("Form").getByName("id_mother_label").getCurrentValue()
stSql = "SELECT NOM_MERE FROM ""T_MOTHER"" WHERE ""NUM_MOTHER"" = ?" _
oInstruction_SQL = = oConnection.prepareStatement(stSql)
oInstruction_SQL.setString(1, valueData)
oResultat = oInstruction_SQL.executeQuery(stSql)
If Not IsNull(oResultat) Then
oResultat.Next()
MsgBox oResultat.getString(1)
End If
End Sub
There are two syntax problems. The first is the _ after the query string, which indicates that the next line is a continuation of that one. It's not a continuation, so remove it.
The second error is on the next line: = =.
When these errors are fixed, the code compiles successfully.

VBA Function Passing Multi Variables back to Sub

I have a large string over 500 char which is called strEssay. I want to use a function(since I will need to look for several patterns) to return two values if (for example the name) Frank is found or not.
This is the function I'm trying to use:
Function NameFinder(strEssay as String, strName as String)
Dim varNameCounter as Variant
Dim strNameFinderResult as String
varNameCounter = 0
strNameFinderResult = ""
If strEssay like "*" & strName & "*" Then
strNameFinderResult = strName
varNameFinderCounter = 1
Else
strNameFinderResult = ""
varNameFinderCounter = .001
EndIf
End Function
I want to be able to return back to my subroutine both 'strNameFinderResult' and 'varNameFinderCounter'.
Is there any way that I can return both values?
If I can't return both simultaneously can I return one through the function and the other through a textbox or something? What would calling the function look like in the subroutine and/or how would I need to change my function?
NameFinder() function, returning array of 3 elements. It is called and returned by TestMe(), writing the following to the console:
Function NameFinder(essay As String, name As String)
Dim nameFinderResult As String
Dim namefinderCounter As String
nameFinderResult = "" & essay & name
namefinderCounter = 0.001 + 12
NameFinder = Array(nameFinderResult, namefinderCounter, "something else")
End Function
Public Sub TestMe()
Dim myArray As Variant
myArray = NameFinder("foo", "bar")
Dim i As Long
For i = LBound(myArray) To UBound(myArray)
Debug.Print myArray(i)
Next i
End Sub
As a general rule, you have to give the routine a type like this:
Function NameFinder(strEssay as String, strName as String) as string
But, that returns only ONE value.
So, a function (as opposed to a sub) returns one value (as a general rule).
However, you CAN also return parameters that you pass. I mean, in above, you can't make TWO assignments to one variable, can you?
So, you can use a Sub like this:
Sub NameFinder(strEssay as String, strName as String, _
strNameFinderResult as string, _
varNameFinderCounter as double)
If strEssay like "*" & strName & "*" Then
strNameFinderResult = strName
varNameFinderCounter = 1
Else
strNameFinderResult = ""
varNameFinderCounter = .001
EndIf
So in code, you now can go:
dim strMyResult as string
dim strFinderCount as Double
Call NameFinder("MyEassy", "Joe Blow", strMyResult, strFinderCount)
So, you can return values with the parameters.
Now, I suppose it possible for some strange reason, that you want to use a function to return two values with a single assignment?
What you would do is this in your code module.
Define a custom type, and use that.
eg this:
Option Compare Database
Option Explicit
Type SearchResult
strName As String
FindCount As Double
End Type
Function NameFinder(strEssay As String, strName As String) As SearchResult
NameFinder.FindCount = 0
NameFinder.strName = ""
If strEssay Like "*" & strName & "*" Then
NameFinder.strName = strName
NameFinder.FindCount = 1
Else
NameFinder.strName = ""
NameFinder.FindCount = 0.001
End If
End Function
So, now to use in code? You can go like this:
dim MyResults as SearchResult
MyResults = NameFinder("My eassy", "Joe Blow")
debug.print "Name found result = " & MyResults.strName
debug.print "Count of find = " & MyResult.FindCount
The VERY nice thing about above is you get full intel-sense in your code editor.
eg this:
So by building a custom data type, you can use "one" assignment for the return type. And you get nice type checking and inteli-sense in the VBA code editor.
And you can even do this:
But, to get both variables, then you would in theory wind up calling the function two times. So, you can actually use the function without declarer of variables like this:
Debug.Print NameFinder("MyEassy", "Joe blow").strName
Debug.Print NameFinder("MyEassy", "Joe blow").FindCount
So, I don't recommend the above, but in the case in which you ONLY want one of the return values, then the raw expression (function) like above would be a use case (and no need to even declare a return variable).
But, without a doubt, define a custom type in code as per above. The reason is now you get a really nice VBA editor type-checking, inteli-sense, and also that you only have to declare "one" variable that holds two values.
In fact, the results are very much like JavaScript, or even c# in which you declare a "class" type. So with a custom "type" you are declaring a data type of your own. And the beauty of this is if you need say 3 values, then once again you create a type with 3 "inside" values.
The you ONLY have to declare that one variable as the custom type.
With this you get:
Very valuable compile time syntax and data type checking of the var types you are using.
You get GREAT VBA inteli-sense while coding - which means less coding mistakes.
And you type far less typing in the VBA editor as it will pop-up the choices for you as you write code. And you can't type or choose the wrong sub - type, as the compiler will catch this.

VB optimize loop avoid with an Evaluate()

I am running a loop that evaluates input given by the user over more than 150k objects. The user sets the info to read like "obj.Name", "obj.Path", "obj.Date"... which may contain also logic evaluations such as "IIf(obj.Params>5,1,0)". It is then provided into the programm as a string.
I used the Evaluate() functions and it does work well, just that it is slow. It takes almost 6h to go over all elements. I was thinking if there is a way in which I can take the requested info and turn it into a straight-forward executable somehow, and avoid using the Evaluate expression in the whole loop (it runs for the number of requested data by the user * 150k).
This is a schematic of the loop I am running:
For Each Object in ObjectsList
For Each UserRequest in Requests
ResultsMatrix(i,j) = Evaluate(Requests(i))
j += 1
Next
i += 1
Next
I store then the results in a Matrix which is pasted in an Excel file at the end. Is there a way in which I can do sort of working the string to be evaluated into a function's return? I'd like to avoid usig the Eval function and parse directly the string in an executable and dont evaluate it for each object. Any tips on speeding up the loop?
It might be worth considering writing the requests into a set of functions and using the .NET CodeDom compilers to build it into a DLL. You can then load the assembly, find the right functions using reflection and put them into an array, then call them using reflection - that way you'll be calling .NET code and it should be far faster. Some (incomplete) code to get you started from a project where I have done this...
Private Function CombineCode() As String
Dim ret As New System.Text.StringBuilder
ret.AppendLine("Imports System")
ret.AppendLine("Imports Microsoft.VisualBasic")
ret.AppendLine()
ret.AppendLine("Namespace " & MainNamespace)
ret.AppendLine("Public Class " & MainClassName)
For Each e In _Entries
ret.AppendLine(e.Value.Code)
Next
ret.AppendLine("End Class")
ret.AppendLine("End Namespace")
Return ret.ToString
End Function
Private Function Compile(Code As String) As Assembly
'Dim d As New Dictionary(Of String, String)
'd.Add("langversion", "14")
Dim VBP As New Microsoft.CodeDom.Providers.DotNetCompilerPlatform.VBCodeProvider()
Dim PM As New System.CodeDom.Compiler.CompilerParameters
'PM.GenerateInMemory = True
PM.GenerateExecutable = False
PM.OutputAssembly = IO.Path.Combine(_Path, GenerateFileName() & ".dll") ' "Generated.dll"
PM.MainClass = MainClassName
PM.IncludeDebugInformation = True
Dim ASM As System.Reflection.Assembly
For Each ASM In AppDomain.CurrentDomain.GetAssemblies()
Try
If ASM.Location <> "" Then PM.ReferencedAssemblies.Add(ASM.Location)
Catch
End Try
Next
PM.ReferencedAssemblies.Add("System.Web.dll")
'Get compilation results
Dim Results As System.CodeDom.Compiler.CompilerResults
Results = VBP.CompileAssemblyFromSource(PM, Code)
'Show possible compilation errors
Dim Err As System.CodeDom.Compiler.CompilerError
For Each Err In Results.Errors
Throw New SyntaxErrorException("Error N. " & Err.ErrorNumber &
" Message: " & Err.ErrorText & " Line " & Err.Line & " in code " & vbCrLf & Code)
Next
Return Results.CompiledAssembly
End Function
Private Sub FindMethods()
Dim dt = (From t In _LatestAssembly.GetTypes() Where t.Name = MainClassName).Single
For Each e In _Entries.Values
e.Method = dt.GetMethod(e.MethodName)
Next
End Sub
Assembly = Assembly.LoadFrom(System.IO.Path.Combine(Path, sd.LatestAssemblyFile))
The Evaluate function is just resources on the computer itself. It's a great candidate for using Parallel.For.
In this case, j is the implied index.
For Each Object in ObjectsList
Parallel.For(0, Requests.Length, New ParallelOptions(), Sub(j, loopState)
ResultsMatrix(i,j) = Evaluate(Requests(j))
End Sub
)
i += 1
Next
Note, that Requests(i) is getting called repeatedly and produces the same result, so I assume you mean Requests(j).

VBA debugging "Expected: ="

Function PrintTableDefs()
Dim aDB As DAO.Database
Dim aTD As DAO.TableDef
Dim aTableName As String
Dim aForeignTableName As String
Dim aString As String
Dim count As Integer
Set count = 0
Set aDB = CurrentDb()
For Each aTD In aDB.TableDefs
Debug.Print aTD.Name
Debug.Print aTD.Connect
Debug.Print ""
count = count + 1
Next
Debug.Print "There are " & count & "table defs."
End Function
When calling this function I get "Compile Error: Expected: =". I have noticed through other questions it is related to parentheses however being mildly unfamiliar with VBA I'm unsure where my syntax is off.
Remove the set from set count = 0
set is only for assigning object references and an Integer is not an object instance.
Alex pointed out the only issue in your function that could throw a compile error: you don't need a set to initialize your count variable, because it is not an object. The rest is correct and should not throw an error, so it is elsewhere.
However your code shows that you don't really understand what is the difference between a sub and a function and it might be helpful to explain it.
A function returns a value, a sub doesn't. That's what's make them different.
You are not returning any value so you should use a sub.
Although your code works fine, because functions that doesn't return a value are accepted by the VBA compiler, it is semantically incorrect and a bad programming habit.
You can make a proper function out of it by returning the number of tables you found (your count variable)
Sub test()
Debug.Print "There are " & PrintTableDefs() & " table defs."
End Sub
Function PrintTableDefs() As Integer
Dim aDB As DAO.Database
Dim aTD As DAO.TableDef
Dim aTableName As String
Dim aForeignTableName As String
Dim aString As String
Dim count As Integer
count = 0
Set aDB = CurrentDb
For Each aTD In aDB.TableDefs
Debug.Print aTD.Name
Debug.Print aTD.Connect
Debug.Print ""
count = count + 1
Next
PrintTableDefs = count
End Function
And if you don't need anything to be returned, make a sub:
Sub PrintTableDefs()
Dim aDB As DAO.Database
Dim aTD As DAO.TableDef
Dim aTableName As String
Dim aForeignTableName As String
Dim aString As String
Dim count As Integer
count = 0
Set aDB = CurrentDb
For Each aTD In aDB.TableDefs
Debug.Print aTD.Name
Debug.Print aTD.Connect
Debug.Print ""
count = count + 1
Next
Debug.Print "There are " & count & " table defs."
End Sub
Additionally, you don't need () when you assign the CurrentDb object :
Set aDB = CurrentDb
My experience is that when calling a function or subroutine in VBA, enclosing your parameters (or lack thereof) in parentheses will cause this error.
There are two ways I know of to handle this:
Just don't use parentheses and always call the sub or function without them. This is fine if you are going from "PrintTableDefs()" to "PrintTableDefs" but can be problematic if the call is nested in a control structure or as another parameter.
Keep your parentheses, because you like parentheses and they remind you of C based language syntax, which helps you forget you are using the sadness of VBA. In that case, always assign the value of a function to a variable "result = PrintTableDefs()" and always use the Call keyword when invoking subroutines.
As an aside: your function returns no value. You should probably replace it with a subroutine, which is done by just replacing the word "Function" with the word "Sub".

VB: Referencing a variable by name in a conditional

I am an amateur programmer and in working with a friend and cannot find a solution to our coding dilemma.
We need to be able to compare if a Variable matches data found in second variable, but the first Variable to be searched is to be dependent on the contents of a third variable. (The third variable would name the first variable to be searched)
Var1, Var2, Var3 ... Var100 'Each with their own values and datatypes;
Var45 = 25
Vartocheck1 = "Var45"
Vattocheck2 = 25
If Vartocheck1 = Vartocheck2 Then
(Stuff)
End If
Essentially, I was wondering if there was a good way to compare two variables, most likely in an If-then statement, where one of the two variables is decided by a third variable's contents.
The idea is Vartocheck1 would be a string, containing the NAME of the variable whose value I want to check against Vartocheck2. The issue is that the variables in the code (in my example: Var1, Var2, Var3 ... Var100) are defined as the process runs, but an external excel chart, when referenced, can change certain variables during the program's execution. I could accomplish what I need with about a million nested if-then statements, but that is slow and messy, and I am hoping there is another way.
I have looked into arrays, but implementing the massive number and size of the arrays would be daunting and require an entire project rewrite.
Is there any good method for comparing a variable like this?
What you are looking for is a concept called reflection. This SO question explains it:
How to get the variable names types, and values in the current class or Method in VB.net?
Based on that I have quickly created the following class:
Public Class Class1
Public This As String
Public That As Boolean
Public Function ListVar() As Boolean
Dim fields As System.Reflection.FieldInfo() = Me.GetType().GetFields()
For Each fld As System.Reflection.FieldInfo In fields
Dim name As String = fld.Name
Dim value = fld.GetValue(Me)
Dim typ As Type = fld.FieldType
Debug.Print(name)
Next
Return True
End Function
End Class
You can call the ListVar function from anywhere by doing this:
Dim c As New Class1
c.ListVar()
Obviously this is not production ready, but should give you a start.
While I still think this is an XY problem, one convenient container in .net is a dictionary. This allows you to store key-value pairs which can be of any type. This gives you some of the tools you would get with a database (which may be a better solution in this case). For example :
Imports System.Collections.Generic
Module Module1
Dim ValueDict As New Dictionary(Of String, Integer)
Sub Main()
Dim r As New Random
'Fill the dictionary with keys "Var1" -> "Var100"
'Fill the values with random integers
For i As Integer = 1 To 100
ValueDict.Add("Var" & i.ToString, r.Next)
Next
'Extract a variable by name
Dim extractedVar As Integer
If ValueDict.TryGetValue("Var23", extractedVar) Then
Console.WriteLine("Var23 has value :" & extractedVar.ToString())
Else
Console.WriteLine("Var23 does not exist in the dictionary")
End If
'enumerate all values
For Each valuePair As KeyValuePair(Of String, Integer) In ValueDict
Console.WriteLine("Variable " & valuePair.Key & _
" = " & valuePair.Value.ToString())
Next
'Get a variable by number
Dim varNumber As Integer = 72
If ValueDict.TryGetValue("Var" & varNumber.ToString(), extractedVar) Then
Console.WriteLine("Var" & varNumber.ToString() & _
" has value :" & extractedVar.ToString())
Else
Console.WriteLine("Var" & varNumber.ToString() & _
" does not exist in the dictionary")
End If
Console.ReadLine()
End Sub
End Module
Other types of operations :
'Check if value exists, Assign a new value or update an existing value
Dim newVal As Integer = 12345
Dim varName As String = "Var147"
If Not ValueDict.ContainsKey(varName) Then
Console.WriteLine(varName & " does not currently exist")
End If
ValueDict.Item(varName) = newVal
Console.WriteLine(varName & " now has value :" & ValueDict.Item(varName).ToString())
'Delete a value
ValueDict.Remove(varName)
If Not ValueDict.ContainsKey(varName) Then
Console.WriteLine(varName & " does not currently exist")
End If