I'm using callByName I VBA to dynamically call different methods of a class. Depending on the method, I will have a different number of arguments which will be held in an array. Unfortunately CallByName accepts a param array, therefore it's not straightforward to pass a variable number. Is there a way around this, I found a solution using the Type Information Library but this does not seem to work on VBA even though I have added it as a reference. Below is an illustration of what I want
Public Sub Initialize_Object(ByRef TaskObject, Task_Collection)
Dim Task_begin As Variant, Method_Parameters As Variant
Task_begin = Task_Collection("Method")
CallByName TaskObject, Task_begin, VbMethod, Method_Parameters
You could use CallByName with an array as argument by changing the method signature :
#If VBA7 Or Win64 Then
Private Declare PtrSafe Function rtcCallByName Lib "VBE7.DLL" ( _
ByVal Object As Object, _
ByVal ProcName As LongPtr, _
ByVal CallType As VbCallType, _
ByRef args() As Any, _
Optional ByVal lcid As Long) As Variant
#Else
Private Declare Function rtcCallByName Lib "VBE6.DLL" ( _
ByVal Object As Object, _
ByVal ProcName As Long, _
ByVal CallType As VbCallType, _
ByRef args() As Any, _
Optional ByVal lcid As Long) As Variant
#End If
Public Function CallByName2(Object As Object, ProcName As String, args() As Variant)
AssignResult CallByName2, rtcCallByName(Object, StrPtr(ProcName), VbMethod, args)
End Function
Private Sub AssignResult(target, result)
If VBA.IsObject(result) Then Set target = result Else target = result
End Sub
Here is a usage example:
Sub UsageExample()
Dim obj As Object, arguments()
Dim obj As New Class1
arguments = Array(1, 3)
CallByName2 obj, "MyMethod", arguments
End Sub
You can't do this dynamically because different methods will require a different amount of arguments and you can't pass arguments where they aren't expected.
If you know the amount of arguments required, then you could call each item of the array and pass that:
CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0), Method_Parameters(1), Method_Parameters(2)
but you would probably have to set up a Select Case block or similar to handle all the different methods:
Select Case Method_Name
Case "Method_1": CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0), Method_Parameters(1)
Case "Method_2": CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0)
Case "Method_3": CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0), Method_Parameters(1), Method_Parameters(2)
End Select
Which can get messy quite easily.
Related
I don't like uninitialized VBA arrays, since it's necessary to check if array is initialized, each time prior using UBound() or For Each to avoid an exception, and there is no native VBA function to check it. That is why I initialize arrays, at least doing them empty with a = Array(). This eliminates the need for extra check in most of cases, so there are no problems with 1d arrays.
For the same reason I tried to create an empty 2d array. It's not possible simply do ReDim a(0 To -1, 0 To 0), transpose 1d empty array or something similar. The only way I came across by chance, is to use MSForms.ComboBox, assign empty array to .List property and read it back. Here is the example, which works in Excel and Word, you need to insert UserForm to VBA Project, place ComboBox on it, and add the below code:
Private Sub ComboBox1_Change()
Dim a()
ComboBox1.List = Array()
a = ComboBox1.List
Debug.Print "1st dimension upper bound = " & UBound(a, 1)
Debug.Print "2nd dimension upper bound = " & UBound(a, 2)
End Sub
After combo change the output is:
1st dimension upper bound = -1
2nd dimension upper bound = 0
Actually it's really the empty 2d array in debug:
Is there more elegant way to create an empty 2d array, without using ComboBox, or UserForm controls in general?
This is only going to work for Windows (not for Mac):
Option Explicit
#If Mac Then
#Else
#If VBA7 Then
Private Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Private Declare PtrSafe Function VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any) As Long
Private Declare PtrSafe Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As LongPtr) As Long
#Else
Private Declare Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As Long
Private Declare Function VariantCopy Lib "OleAut32.dll" (pvargDest As Variant, pvargSrc As Any) As Long
Private Declare Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As Long) As Long
#End If
#End If
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
#If VBA7 Then
ptr As LongPtr
#Else
ptr As Long
#End If
End Type
Public Function EmptyArray(ByVal numberOfDimensions As Long, ByVal vType As VbVarType) As Variant
'In Visual Basic, you can declare arrays with up to 60 dimensions
Const MAX_DIMENSION As Long = 60
If numberOfDimensions < 1 Or numberOfDimensions > MAX_DIMENSION Then
Err.Raise 5, "EmptyArray", "Invalid number of dimensions"
End If
#If Mac Then
Err.Raise 298, "EmptyArray", "OleAut32.dll required"
#Else
Dim bounds() As SAFEARRAYBOUND
#If VBA7 Then
Dim ptrArray As LongPtr
#Else
Dim ptrArray As Long
#End If
Dim tVariant As tagVariant
Dim i As Long
'
ReDim bounds(0 To numberOfDimensions - 1)
'
'Make lower dimensions [0 to 0] instead of [0 to -1]
For i = 1 To numberOfDimensions - 1
bounds(i).cElements = 1
Next i
'
'Create empty array and store pointer
ptrArray = SafeArrayCreate(vType, numberOfDimensions, bounds(0))
'
'Create a Variant pointing to the array
tVariant.vt = vbArray + vType
tVariant.ptr = ptrArray
'
'Copy result
VariantCopy EmptyArray, tVariant
'
'Clean-up
SafeArrayDestroy ptrArray
#End If
End Function
You can now create empty arrays with different number of dimensions and data types:
Sub Test()
Dim arr2D() As Variant
Dim arr4D() As Double
'
arr2D = EmptyArray(2, vbVariant)
arr4D = EmptyArray(4, vbDouble)
Stop
End Sub
Update 30/09/2022
I've created an EmptyArray method (same signature) in my MemoryTools library on GitHub. That version will work on both Windows and Mac.
Idk man - I think you stumbling onto this property was pretty wild.
I'd probably stop here and just do:
Function Empty2DArray() As Variant
With CreateObject("Forms.ComboBox.1")
.List = Array()
Empty2DArray = .List
End With
End Function
And use it like: a = Empty2DArray
You don't need to create the userform or combobox - you can just use CreateObject.
But as others have said, it probably makes more sense to do error handling when checking whether or not your arrays are initialized.
Is it really not possible to declare a 0-length array in VBA? If I try this:
Dim lStringArr(-1) As String
I get a compile error saying range has no values. If I try to trick the compiler and redim at runtime like this:
ReDim lStringArr(-1)
I get a subscript out of range error.
I've varied the above around a bit but with no luck e.g.
Dim lStringArr(0 To -1) As String
Use Case
I want to convert a variant array to a string array. The variant array may be empty as it comes from the Keys property of a dictionary. The keys property gives back an array of variants. I want an array of strings to use in my code, as I have some functions for processing string arrays I'd like to use. Here's the conversion function I'm using. This throws a subscript out of range error due to lMaxIndex being = -1:
Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
Dim lStringArr() As String
Dim lMaxIndex As Long, lMinIndex As Long
lMaxIndex = UBound(pVariants)
lMinIndex = LBound(pVariants)
ReDim lStringArr(lMaxIndex)
Dim lVal As Variant
Dim lIndex As Long
For lIndex = lMinIndex To lMaxIndex
lStringArr(lIndex) = pVariants(lIndex)
Next
mVariantArrayToStringArray = lStringArr
End Function
Hack
Return a singleton array containing an empty string. Note- this isn't what we want. We want an empty array- such that looping over it is like doing nothing. But a singleton array containing an empty string will often work e.g. if we later want to join all the strings together in the string array.
Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
Dim lStringArr() As String
Dim lMaxIndex As Long, lMinIndex As Long
lMaxIndex = UBound(pVariants)
lMinIndex = LBound(pVariants)
If lMaxIndex < 0 Then
ReDim lStringArr(1)
lStringArr(1) = ""
Else
ReDim lStringArr(lMaxIndex)
End If
Dim lVal As Variant
Dim lIndex As Long
For lIndex = lMinIndex To lMaxIndex
lStringArr(lIndex) = pVariants(lIndex)
Next
mVariantArrayToStringArray = lStringArr
End Function
Update since answer
Here is the function I'm using for converting a variant array to a string array. Comintern's solution seems more advanced and general, and I may switch to that one day if I'm still stuck coding in VBA:
Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
Dim lStringArr() As String
Dim lMaxIndex As Long, lMinIndex As Long
lMaxIndex = UBound(pVariants)
lMinIndex = LBound(pVariants)
If lMaxIndex < 0 Then
mVariantArrayToStringArray = Split(vbNullString)
Else
ReDim lStringArr(lMaxIndex)
End If
Dim lVal As Variant
Dim lIndex As Long
For lIndex = lMinIndex To lMaxIndex
lStringArr(lIndex) = pVariants(lIndex)
Next
mVariantArrayToStringArray = lStringArr
End Function
Notes
I use Option Explicit. This can't change as it safeguards the rest of the code in the module.
As noted in the comments, you can do this "natively" by calling Split on a vbNullString, as documented here:
expression - Required. String expression containing substrings and delimiters. If expression is a zero-length string(""), Split returns an empty array, that is, an array with no elements and no data.
If you need a more general solution (i.e., other data types, you can call the SafeArrayRedim function in oleaut32.dll directly and request that it re-dimensions the passed array to 0 elements. You do have to jump through a couple of hoops to get the base address of the array (this is due to a quirk of the VarPtr function).
In the module declarations section:
'Headers
Private Type SafeBound
cElements As Long
lLbound As Long
End Type
Private Const VT_BY_REF = &H4000&
Private Const PVDATA_OFFSET = 8
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
Private Declare Sub SafeArrayRedim Lib "oleaut32" (ByVal psa As LongPtr, _
ByRef rgsabound As SafeBound)
The procedure - pass it an initialized array (any type) and it will remove all elements from it:
Private Sub EmptyArray(ByRef vbArray As Variant)
Dim vtype As Integer
CopyMemory vtype, vbArray, LenB(vtype)
Dim lp As LongPtr
CopyMemory lp, ByVal VarPtr(vbArray) + PVDATA_OFFSET, LenB(lp)
If Not (vtype And VT_BY_REF) Then
CopyMemory lp, ByVal lp, LenB(lp)
Dim bound As SafeBound
SafeArrayRedim lp, bound
End If
End Sub
Sample usage:
Private Sub Testing()
Dim test() As Long
ReDim test(0)
EmptyArray test
Debug.Print LBound(test) '0
Debug.Print UBound(test) '-1
End Sub
Per Comintern's comment.
Make a dedicated utility function that returns the result of the VBA.Strings.Split function, working off vbNullString, which is effectively a null string pointer, which makes the intent more explicit than using an empty string literal "", which would also work:
Public Function EmptyStringArray() As String()
EmptyStringArray = VBA.Strings.Split(vbNullString)
End Function
Now branch your function to check for the existence of keys, and return EmptyStringArray if there are none, otherwise proceed to resize your result array and convert each source element.
If we're going to use WinAPI anyway, we can also cleanly create the array from scratch using the WinAPI SafeArrayCreate function instead of redimensioning it.
Struct declarations:
Public Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Public Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
pSomething As LongPtr
End Type
WinAPI declarations:
Public Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Public Declare PtrSafe Sub VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any)
Public Declare PtrSafe Sub SafeArrayDestroy Lib "OleAut32.dll"(ByVal psa As LongPtr)
Use it:
Public Sub Test()
Dim bounds As SAFEARRAYBOUND 'Defaults to lower bound 0, 0 items
Dim NewArrayPointer As LongPtr 'Pointer to hold unmanaged string array
NewArrayPointer = SafeArrayCreate(vbString, 1, bounds)
Dim tagVar As tagVariant 'Unmanaged variant we can manually manipulate
tagVar.vt = vbArray + vbString 'Holds a string array
tagVar.pSomething = NewArrayPointer 'Make variant point to the new string array
Dim v As Variant 'Actual variant
VariantCopy v, ByVal tagVar 'Copy unmanaged variant to managed one
Dim s() As String 'Managed string array
s = v 'Copy the array from the variant
SafeArrayDestroy NewArrayPointer 'Destroy the unmanaged SafeArray, leaving the managed one
Debug.Print LBound(s); UBound(s) 'Prove the dimensions are 0 and -1
End Sub
SafeArrayCreateVector
One other option, mentioned in answers elsewhere,1 2 3 is with SafeArrayCreateVector. While SafeArrayCreate returns a pointer as shown by Erik A, this one returns an array directly. You'd need a declaration for each type, like this:
Private Declare PtrSafe Function VectorBoolean Lib "oleaut32" Alias "SafeArrayCreateVector" ( _
Optional ByVal vt As VbVarType = vbBoolean, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) _
As Boolean()
Private Declare PtrSafe Function VectorByte Lib "oleaut32" Alias "SafeArrayCreateVector" ( _
Optional ByVal vt As VbVarType = vbByte, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) _
As Byte()
The same works for Currency, Date, Double, Integer, Long, LongLong, Object, Single, String and Variant.
If you're willing to stuff those into a module, you can create a function that works just like Array() but with an initial argument that sets the type:
Function ArrayTyped(vt As VbVarType, ParamArray argList()) As Variant
Dim ub As Long: ub = UBound(argList) + 1
Dim ret As Variant 'a variant to hold the array to be returned
Select Case vt
Case vbBoolean: Dim bln() As Boolean: bln = VectorBoolean(, , ub): ret = bln
Case vbByte: Dim byt() As Byte: byt = VectorByte(, , ub): ret = byt
Case vbCurrency: Dim cur() As Currency: cur = VectorCurrency(, , ub): ret = cur
Case vbDate: Dim dat() As Date: dat = VectorDate(, , ub): ret = dat
Case vbDouble: Dim dbl() As Double: dbl = VectorDouble(, , ub): ret = dbl
Case vbInteger: Dim i() As Integer: i = VectorInteger(, , ub): ret = i
Case vbLong: Dim lng() As Long: lng = VectorLong(, , ub): ret = lng
Case vbLongLong: Dim ll() As LongLong: ll = VectorLongLong(, , ub): ret = ll
Case vbObject: Dim obj() As Object: obj = VectorObject(, , ub): ret = obj
Case vbSingle: Dim sng() As Single: sng = VectorSingle(, , ub): ret = sng
Case vbString: Dim str() As String: str = VectorString(, , ub): ret = str
End Select
Dim argIndex As Long
For argIndex = 0 To ub - 1
ret(argIndex) = argList(argIndex)
Next
ArrayTyped = ret
End Function
This gives empty or filled arrays, like Array(). For example:
Dim myLongs() as Long
myLongs = ArrayTyped(vbLong, 1,2,3) '<-- populated Long(0,2)
Dim Pinnochio() as String
Pinnochio = ArrayTyped(vbString) '<-- empty String(0,-1)
Same ArrayTyped() Function With SafeArrayRedim
I like this function, but all those API calls for each type seem bloated. It seems the same function can be done with SafeArrayRedim, and just one API call. Declared as such:
Private Declare PtrSafe Function PtrRedim Lib "oleaut32" Alias "SafeArrayRedim" (ByVal arr As LongPtr, ByRef dims As Any) As Long
The same ArrayTyped function could then look like this:
Function ArrayTyped(vt As VbVarType, ParamArray argList()) As Variant
Dim ub As Long: ub = UBound(argList) + 1
Dim ret As Variant 'a variant to hold the array to be returned
Select Case vt
Case vbBoolean: Dim bln() As Boolean: ReDim bln(0): PtrRedim Not Not bln, ub: ret = bln
Case vbByte: Dim byt() As Byte: ReDim byt(0): PtrRedim Not Not byt, ub: ret = byt
Case vbCurrency: Dim cur() As Currency: ReDim cur(0): PtrRedim Not Not cur, ub: ret = cur
Case vbDate: Dim dat() As Date: ReDim dat(0): PtrRedim Not Not dat, ub: ret = dat
Case vbDouble: Dim dbl() As Double: ReDim dbl(0): PtrRedim Not Not dbl, ub: ret = dbl
Case vbInteger: Dim i() As Integer: ReDim i(0): PtrRedim Not Not i, ub: ret = i
Case vbLong: Dim lng() As Long: ReDim lng(0): PtrRedim Not Not lng, ub: ret = lng
Case vbLongLong: Dim ll() As LongLong: ReDim ll(0): PtrRedim Not Not ll, ub: ret = ll
Case vbObject: Dim obj() As Object: ReDim obj(0): PtrRedim Not Not obj, ub: ret = obj
Case vbSingle: Dim sng() As Single: ReDim sng(0): PtrRedim Not Not sng, ub: ret = sng
Case vbString: Dim str() As String: ReDim str(0): PtrRedim Not Not str, ub: ret = str
Case vbVariant: Dim var() As Variant: ReDim var(0): PtrRedim Not Not var, ub: ret = var
End Select
Dim argIndex As Long
For argIndex = 0 To ub - 1
ret(argIndex) = argList(argIndex)
Next
ArrayTyped = ret
End Function
A couple of other resources:
Following logic here you can also do this with user defined types. Just add another API call like the others. More discussion here.
If anyone wants empties with multiple dimensions, there is another interesting approach using SafeArrayCreate here.
What you can do is declare a variable length array of whatever type you need by declaring it with no specified length in the Dim. Then call IsArray with the array variable. It will return True but we're not interested in that, this just initialises the array.
Dim lStringArr() As String
' Call IsArray to initialise the array
IsArray lStringArr
' Print the amount of elements in the array to the Immediate window
Debug.Print UBound(lStringArr) - LBound(lStringArr) + 1
' It should print 0 without errors
I have the following code which simply executes a stored procedure which accepts 1 parameter.
Public Function GetData(ByVal Faccode As String, Optional ByRef s As String = "") As DataSet
Dim params As SqlParameter() = {New SqlParameter("#aFacilityCode", SqlDbType.VarChar, ParameterDirection.Input)}
' Set the value
params(0).Value = "SW29" 'Faccode
Try
Dim DSet As DataSet = RunProcedure("usp_FL_GetAllData", params, "ContactData")
Return DSet
Catch ex As Exception
Return Nothing
End Try
End Function
Protected Overloads Function RunProcedure( _
ByVal storedProcName As String, _
ByVal parameters As IDataParameter(), _
ByVal tableName As String) _
As DataSet
Dim dataSet As New dataSet
Try
myConnection.Open()
Dim sqlDA As New SqlDataAdapter
sqlDA.SelectCommand = BuildQueryCommand(storedProcName, parameters)
sqlDA.Fill(dataSet, tableName)
Return dataSet
Catch ex As Exception
Return Nothing
Finally
If myConnection.State = ConnectionState.Open Then
myConnection.Close()
End If
End Try
End Function
Private Function BuildQueryCommand( _
ByVal storedProcName As String, _
ByVal parameters As IDataParameter()) _
As SqlCommand
Dim command As New SqlCommand(storedProcName, myConnection)
command.CommandType = CommandType.StoredProcedure
Dim parameter As SqlParameter
For Each parameter In parameters
command.Parameters.Add(parameter)
Next
Return command
End Function
The SQL procedure is defined like so:
CREATE PROCEDURE [dbo].[usp_FL_GetAllData]
(
#aFacilityCode VARCHAR(10)
)
When I run the software, SQL Profiler shows this call is being made:
exec usp_FL_GetAllData #aFacilityCode='S'
Initially, I was assigning the value Faccode for my parameter in the GetData function but noticed this weird truncation, which is why I'm now hardcoding the value.
The only thing I could think of is that the SQL procedure defined the parameter as a varchar(1) but it's defined as 10 so I don't know why this is happening. RunProcedure is used in many places which do not exhibit this behavior.
What else could be causing this?
To see why removing the parameter direction from your constructor call solves the problem, take a look at the list of constructors defined by the SqlParameter class. Note that there is no constructor that takes a parameter name, SqlDbType, and ParameterDirection; the constructor you're actually invoking is this one, whose third parameter is the parameter size. Because the backing value of ParameterDirection.Input is 1, you are explicitly setting the size of the parameter to one character.
When you instead invoke a constructor that doesn't explicitly give a size, the object infers the size of the parameter from the value that you assign, as described in the documentation for that property.
This makes a number of important changes to your code. It does address the parameter length issue, but you'll need to check if it actually helps.
's was not used, and ByRef is a code smell in .Net
Public Function GetData(ByVal Faccode As String) As DataSet
Dim params As New SqlParameter("#aFacilityCode", SqlDbType.VarChar, 10)
If String.IsNullOrEmpty(Faccode) Then Faccode = "SW29"
params.Value = Faccode
'Removed Try/Catch handler. It's NEVER a good idea to just swallow exceptions like that. Let the exception bubble up to higher level code that knows how to handle it.
Return RunProcedure("usp_FL_GetAllData", "ContactData", params)
End Function
'Note the change to SqlParameter. IDataParameter does not have a Length or Size property. That MIGHT be your problem.
'Also note the use of ParamArray... required changing the order of the arguments, but helped simplify code in the first function
Protected Overloads Function RunProcedure( _
ByVal storedProcName As String, ByVal tableName As String, _
ByVal ParamArray parameters() As SqlParameter) _
As DataSet
Dim dataSet As New dataSet
Using myConnection As New SqlConnection("string here"), _
command As SqlCommand = BuildQueryCommand(storedProcName, parameters), _
sqlDA As New SqlDataAdapter(command)
command.Connection = myConnection
sqlDA.Fill(dataSet, tableName) '.Fill() will open the connection for you if needed
End Using
Return dataSet
End Function
Private Function BuildQueryCommand( _
ByVal storedProcName As String, _
ByVal ParamArray parameters() As SqlParameter) _
As SqlCommand
Dim command As New SqlCommand(storedProcName)
command.CommandType = CommandType.StoredProcedure
If parameters IsNot Nothing Then command.Parameters.AddRange(parameters)
Return command
End Function
Note these changes WILL likely impact other code in your application, but they are important.
Changing the first line of GetData from this:
Dim params As SqlParameter() = {New SqlParameter("#aFacilityCode", SqlDbType.VarChar, ParameterDirection.Input)}
To this:
Dim params As SqlParameter() = {New SqlParameter("#aFacilityCode", SqlDbType.VarChar)}
Fixed my issue. I'm not sure why, and if anyone knows I'd love to know why.
Some functions such as Split() will return an array with -1 for the upper bound and zero for the lower bound if the array has no items, eg:
Dim s() As String
s = Split("", ",")
Debug.Print UBound(s)
Debug.Pring LBound(s)
In this case UBound(s) will equal -1 and LBound(s) will equal 0. I have a fair amount of code checking for -1 on the upper bound to see if the array has values or not. This works great.
The problem is that I now want to change the array data type from string to long. I cannot seem to create an array of longs with an upper bound of -1 and a lower bound of 0, and the Split() and Join() functions only operate on string arrays.
I would like to be able to return a long array with an upper bound of -1. Is this possible?
I don't think you can do it in VB6 it self. However, if you're willing to use the Windows API function SafeArrayCreateVector you can do it:
Private Declare Function LongSplitEmulator Lib "OLEAUT32.DLL" Alias "SafeArrayCreateVector" _
(Optional ByVal vt As VbVarType = vbLong, _
Optional ByVal low As Long = 0, _
Optional ByVal count As Long = 0) As Long()
Dim a() As Long
a = LongSplitEmulator()
MsgBox UBound(a)
If you need to do it for other datatypes you can change the vt parameter.
Please note, I think I originally found out about this from Vi2's answer to this discussion.
You could write your own split function to do this:
Private Sub SplitLongs(ByVal strData As String, ByRef lng() As Long)
Dim i As Integer
Dim s() As String
s = Split(strData, ",")
If UBound(s) = -1 Then
ReDim lng(-1 To -1)
Else
ReDim lng(LBound(s) To UBound(s))
For i = LBound(s) To UBound(s)
If IsNumeric(s(i)) Then lng(i) = s(i)
Next
End If
End Sub
One problem with VB6 is there is no way to reliably create or detect an empty (or uninitialized) array. Sometimes, it is possible to detect an uninitialized array by checking whether the upper-bound is greater than the lower-bound; however, this is neither elegant nor documented. The best way to accomplish such a thing properly is to enclose the array in a Variant, and set the Variant to Empty to deinitialize the array. You may then use a check such as If VarType(v) = vbEmpty ...
Another way is a strongly typed "factory" function:
Private Declare Function SafeArrayRedim Lib "oleaut32.dll" (ByVal ArrayPtr As Long, ByRef DataPtr As tagSAFEARRAYBOUND) As Long
Private Type tagSAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Public Type Feed
ID As String
Name As String
Active As Boolean
BasePath As String
End Type
Public Sub EmptyFeedArray(ByRef Arr() As Feed)
Dim Data As tagSAFEARRAYBOUND
Dim lngErr As Long
'Redim to one item
ReDim Arr(0 To 0)
'Reset the safe array to empty
lngErr = SafeArrayRedim(Not Not Arr, Data)
'Raise any errors
If lngErr <> 0 Then Err.Raise lngErr
End Sub
I think this also works with integral types.
Ok, so I have these functions I'm tring to use via my vba code.
It's probably the as it would have been with vbs as well.
Here's the function(s)
'declarations for working with Ini files
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias _
"GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
'// INI CONTROLLING PROCEDURES
'reads an Ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v + 0)
End Function
'reads an Ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v + 0)
End Function
How can I use this to create a function that basically allows me to specify only the section I want to look in, and then find each ini string within that section and put it into an array and return that Array so I can do a loop with it?
Edit: I see that ReadIniSection returns all of the keys in a huge string.
Meaning, I need to split it up.
ReadIniSection returns something that looks like this:
"Fornavn=FORNAVN[]Etternavn=ETTERNAVN" etc etc. The[] in the middle there isn't brackets, it's a square. Probably some character it doesn't recognize. So I guess I should run it through a split command that takes the value between a = and the square.
See if this helps - splitting on nullchar \0:
Private Sub ListIniSectionLines()
Dim S As String: S = ReadIniSection("c:\windows\win.ini", "MAIL")
Dim vLines As Variant: vLines = Split(S, Chr$(0))
Dim vLine As Variant
For Each vLine In vLines
Debug.Print vLine
Next vLine
End Sub