Parse enum values by name in VBA - vba

I want to write some VBA code that should parse MSForms-constant names (given as a string, like "fmTextAlignLeft") into their actual value. Since there is no native way to do so I was considering to put the name of the constant into a powershell code that will then be executed and return the result.
Private Sub ParseEnumByName(EnumConst As String)
Dim WScript As New WshShell
Dim PSCode As String
Dim Result
PSCode = "(some code)" & EnumConst & "(more code with exit $Value statement)"
Result = WScript.Run("Powershell -command """ & PSCode & """", 0, True)
ParseEnumByName = Result
End Sub
This should be feasible by iterating through all enums in the MSForms library and get the values out of them with something like
[System.Enum]::GetNames( [System.Windows.Forms.FormBorderStyle] ) or maybe something like explained here: How to convert a string to a enum?
The problem is that the System.Windows.Forms library contains totally different enums and typenames than the MSForms library available in VBA.
I tried to Add-Type -Path "C:\Windows\SysWOW64\FM20.DLL" where the MSForms library is stored but it returns an error saying the file or assembly or some related file could not be found.
How may I get a reference to MSForms in Powershell?
Edit: I have actually found a demi-native way in VBA (Excel VBA only) to solve this issue without passing values to external script hosts. Please see below.

Here's the function I figured out. So far it seems to work with all pre-defined enums and constants and also self defined enums in Excel. The function must be placed in a module!
Static Function ParseValue(StringValue) As Variant
Dim ParseValueBuffer As Variant
If IsEmpty(ParseValueBuffer) Then
ParseValueBuffer = 1
Application.Run ("'ParseValue " & StringValue & "'")
ParseValue = ParseValueBuffer
ParseValueBuffer = Empty
Else
ParseValueBuffer = StringValue
End If
End Function
Sub TestMe()
MsgBox "First line" & ParseValue("vbcrlf") & "Second line"
MsgBox ParseValue("fmTextAlignCenter") 'Should return "2" (if MSForms is referenced)
MsgBox ParseValue("rgbblue") 'Should return 16711680
End Sub

Related

How to get data in Access VBA from a C# method that returns an object List

I'm calling a C# WebService method called getInterventions() on a VBA Access 2003 application through a custom DLL. The signature of this method is as follows:
List<Item> getInterventions(string, string, string, string, string, string)
Item is a custom defined class.
When I try to retrieve the result of getInterventions() on VBA Access code, it pops a VBA Runtime error 242 : object required
The following is my code:
Dim WsObject As Object
Dim result As Object
Set WsObject = CreateObject("Namespace1.Path.To.Class") 'This isn't the actual DLL path as I cannot share that
'Set result = WsObject .getSingleIntervention("123, "0", "123456789", "") ' this works
Set result = WsObject .getInterventions("", "", "123456789", "", "", "") 'this doesn't work
If result Is Nothing Then
'do some stuff
Else
'do some other stuff
End If
getSingleIntervention() is a similar method which returns a single object rather than a list of objects. Returning the result of this method works without issues (see commented line). This proves that both the WS & DLL calls work. This method is defined as follows:
Item getSingleIntervention(string, string, string, string)
I have tested calling getInterventions() directly from the C# code via Visual Studio 2015 with the same parameters I'm passing in my VBA code and it worked. This proves that it's not an issue with parameters or the method content.
My conclusion:
I am guessing it's something to do with the fact that I can't simply store a C# List of objects into a VBA Object.
Any help would be appreciated, thank you.
Please, automatically add mscorlib.tlb reference, running the next code:
Sub addMscorlibRef() 'necessary to use ArrayList
'Add a reference to 'Mscorlib.dll':
'In case of error ('Programmatic access to Visual Basic Project not trusted'):
'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
' check "Trust access to the VBA project object model"
If dir("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", vbDirectory) = "" Then _
MsgBox "You need to install ""Framework version 3.5"".": Exit Sub
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\Microsoft.NET\Framework64\v4.0.30319\mscorlib.tlb"
If err.Number = 32813 Then
err.Clear: On Error GoTo 0
MsgBox "The reference already exists...": Exit Sub
Else
On Error GoTo 0
MsgBox """Mscorlib"" reference added successfully..."
End If
End Sub
Then try declaring Dim result As ArrayList.
The ArrayList is the same one that is used in C#. Then, adapt the dll to use such an object. As you deduced, no any object able to be used in VBA can receive the C# list object content.

Generate a SSRS report in default browser from VB.NET

I have a VB.NET solution that stores data to a SQL database. I have written the first of several SSRS reports. Now I want to generate the reports from my VB.NET solution.
I have a subroutine that will generate the report,
Public Shared Sub GenerateReport(ByVal RptName As String, ByVal ParamArray Params() As Object)
Dim strPath As String = sqlSSRS + Replace(RptName, " ", "%20")
Dim _class As cParameters
'strPath += "&rc:Parameters=false&rs:Command=Render"
'strPath += "&rs:Command=Render"
For i As Integer = 0 To UBound(Params)
_class = DirectCast(Params(i), cParameters)
strPath += "&" & _class.ParamName & "=" & _class.Value
Next
System.Diagnostics.Process.Start(strPath)
End Sub
If I generate a path with no parameters the report will open in the default browser. So this works...
http://sqlServerName:80/Reports/report/ToolCrib/Toolbox%20by%20Installer
But neither this ...
http://sqlServerName:80/Reports/report/ToolCrib/Toolbox%20by%20Installer&#UserID=7&#ProjectID=20026&#ToolboxID=10&#ToolStatus=2
or this
http://sqlServerName:80/Reports/report/ToolCrib/Toolbox%20by%20Installer&UserID=7&ProjectID=20026&ToolboxID=10&ToolStatus=2
does.
I obviously have an issue passing parameters. In one case I don't need them but in other cases I want to provide them, which is why I wrote the GenerateReport routine with the optional Parameter array. Here is the error message I get which I know from past experience is sort of a catch all when MS doesn't "know" how else to classify an SSRS error.
The path of the item '/ToolCrib/Toolbox by Installer&UserID=7&ProjectID=20026&ToolboxID=10&ToolStatus=2' is not valid. The full path must be less than 260 characters long; other restrictions apply. If the report server is in native mode, the path must start with slash. (rsInvalidItemPath)
Any help will be greatly appreciated.
You path needs to use reportserver? instead of Reports/report when using parameters.
Try
http://sqlServerName:80/reportserver?/ToolCrib/Toolbox%20by%20Installer&UserID=7&ProjectID=20026&ToolboxID=10&ToolStatus=2
You could add a REPLACE:
strPath = Replace(strPath, "/Reports/report/", "/reportserver?/")
For more reading, you can check out
MS Docs url-access-parameter-reference

Excel VBA bug accessing HelpFile property from macro-disabled instance?

I think I've stumbled upon a bug in Excel - I'd really like to verify it with someone else though.
The bug occurs when reading the Workbook.VBProject.HelpFile property when the workbook has been opened with the opening application's .AutomationSecurity property set to ForceDisable. In that case this string property returns a (probably) malformed Unicode string, which VBA in turn displays with question marks. Running StrConv(..., vbUnicode) on it makes it readable again, but it sometimes looses the last character this way; this might indicate that the unicode string is indeed malformed or such, and that VBA therefore tries to convert it first and fails.
Steps to reproduce this behaviour:
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a new code module and add some code to it (like e.g. Dim a As Long)
Enter the project's properties (menu Tools... properties)
Enter "description" as Project description and "abc.hlp" as Help file name
Save the workbook as a .xlsb or .xlsm
Close the workbook
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a fresh new code module
Paste the code below in it
Adjust the path on the 1st line so it points to the file you created above
Run the Test routine
The code to use:
Const csFilePath As String = "<path to your test workbook>"
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile)
Call MsgBox(testType & " - helpfile converted: " & StrConv(theWorkbook.VBProject.HelpFile, vbUnicode))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description)
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
Conclusion when working from Excel 2010:
.Description is always readable, no matter what (so it's not like all string properties behave this way)
xlsb and xlsm files result in an unreadable .HelpFile only when macros are disabled
xls files result in an unreadable .HelpFile in all cases (!)
It might be even weirder than that, since I swear I once even saw the questionmarks-version pop up in the VBE GUI when looking at such a project's properties, though I'm unable to reproduce that now.
I realize this is an edge case if ever there was one (except for the .xls treatment though), so it might just have been overlooked by Microsoft's QA department, but for my current project I have to get this working properly and consistently across Excel versions and workbook formats...
Could anyone else test this as well to verify my Excel installation isn't hosed? Preferably also with another Excel version, to see if that makes a difference?
Hopefully this won't get to be a tumbleweed like some of my other posts here :) Maybe "Tumbleweed generator" might be a nice badge to add...
UPDATE
I've expanded the list of properties to test just to see what else I could find, and of all the VBProject's properties (BuildFileName, Description, Filename, HelpContextID, HelpFile, Mode, Name, Protection and Type) only .HelpFile has this problem of being mangled when macros are off.
UPDATE 2
Porting the sample code to Word 2010 and running that exhibits exactly the same behaviour - the .HelpFile property is malformed when macros are disabled. Seems like the code responsible for this is Office-wide, probably in a shared VBA library module (as was to be expected TBH).
UPDATE 3
Just tested it on Excel 2007 and 2003, and both contain this bug as well. I haven't got an Excel XP installation to test it out on, but I can safely say that this issue already has a long history :)
I've messed with the underlying binary representation of the strings in question, and found out that the .HelpFile string property indeed returns a malformed string.
The BSTR representation (underwater binary representation for VB(A) strings) returned by the .HelpFile property lists the string size in the 4 bytes in front of the string, but the following content is filled with the ASCII representation and not the Unicode (UTF16) representation as VBA expects.
Parsing the content of the BSTR returned and deciding for ourselves which format is most likely used fixes this issue in some circumstances. Another issue is unfortunately at play here as well: it only works for even-length strings... Odd-length strings get their last character chopped off, their BSTR size is reported one short, and the ASCII representation just doesn't include the last character either... In that case, the string cannot be recovered fully.
The following code is the example code in the question augmented with this fix. The same usage instructions apply to it as for the original sample code. The RecoverString function performs the needed magic to, well, recover the string ;) DumpMem returns a 50-byte memory dump of the string you pass to it; use this one to see how the memory is layed out exactly for the passed-in string.
Const csFilePath As String = "<path to your test workbook>"
Private Declare Sub CopyMemoryByte Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Integer, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryDWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Function DumpMem(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
Dim dump As String
Dim offset As Long
For offset = -4 To 50
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
dump = dump & Right("00" & Hex(nextByte), 2) & " "
Next
DumpMem = dump
End Function
Function RecoverString(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
If textAddress <> 0 Then
Dim textSize As Long
Call CopyMemoryDWord(textSize, textAddress - 4, 4)
Dim recovered As String
Dim foundNulls As Boolean
foundNulls = False
Dim offset As Long
For offset = 0 To textSize - 1
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
recovered = recovered & Chr(CLng(nextByte) + IIf(nextByte < 0, &H80, 0))
If nextByte = 0 Then
foundNulls = True
End If
Next
Dim isNotUnicode As Boolean
isNotUnicode = isNotUnicode Mod 2 = 1
If foundNulls And Not isNotUnicode Then
recovered = ""
For offset = 0 To textSize - 1 Step 2
Dim nextWord As Integer
Call CopyMemoryWord(nextWord, textAddress + offset, 2)
recovered = recovered & ChrW(CLng(nextWord) + IIf(nextWord < 0, &H8000, 0))
Next
End If
End If
RecoverString = recovered
End Function
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile & " - " & RecoverString(theWorkbook.VBProject.HelpFile))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description & " - " & RecoverString(theWorkbook.VBProject.Description))
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub

Write a variable to a file that has a different type than the function assigned to the variable

I have the following code that I am using to parse out a test file. I am getting variable conversion error in Sub Main() when I assign file = Read(). The return value of Read() is a TextFieldParser type. How do I assign the proper variable type to "file" so I can write the output to a text file?
Thanks!
Module Module1
Function Read()
Using MyReader As New FileIO.TextFieldParser("C:\Users\Colin\Desktop\Parse_Me.txt")
Dim currentRow As String
While Not MyReader.EndOfData
Try
currentRow = MyReader.ReadLine()
Console.WriteLine(Parse_me(currentRow))
Catch ex As FileIO.MalformedLineException
MsgBox("Line " & ex.Message &
" is invalid. Skipping")
End Try
End While
Return MyReader
MyReader.Close()
End Using
End Function
Function Parse_me(ByVal test As String)
Dim Set_1, Set_2, Set_3, Set_4, Set_5 As String
Dim new_string As String
Set_1 = test.Substring(0, 4)
Set_2 = test.Substring(7, 2)
Set_3 = test.Substring(11, 1)
Set_4 = test.Substring(14, 4)
Set_5 = test.Substring(20, 4)
new_string = Set_1 & " " & Set_2 & " " & Set_3 & " " & Set_4 & " " & Set_5
Return new_string
End Function
Sub Main()
Dim file As Object
file = Read()
FilePutObject("C:\Users\Colin\Desktop\Parse_Meoutput.txt", file)
End Sub
End Module
Here's how FilePutObject is supposed to work (example taken from MSDN documentation for FilePutObject):
Sub WriteData()
Dim text As String = "test"
FileOpen(1, "test.bin", OpenMode.Binary)
FilePutObject(1, text)
FileClose(1)
End Sub
The 1 act as an identifier for the file. Note also that the file name is passed to FileOpen before calling FilePutObject, and that FileClose is called afterwards. Also note that a string is being written to the file. I don't know which types of data are valid for being passed to FilePutObject, but FileIO.TextFieldParser is definitely not one of them (I just tried it).
Correct me if I'm wrong, but I'm pretty sure that FilePutObject is one of those carry-overs from VB6. If you're writing new code, I would rather use a Stream object for my I/O. For one, it's a lot more .Net-ish (i.e., type-safe, object-oriented, etc). And as far as usability goes, it's a lot clearer how a Stream works, not to mention it doesn't involve passing arbitrary integers as handles to functions in order to identify which file you'd like to work with. And to top it all off, a Stream works whether you want to write to a file, to the console, or send the data to another machine. To sum up, I would definitely look up the Stream class, some of its child classes (like FileStream, and whatever else appeals to you), and some associated types (such as the TextWriter class for conveniently writing text).
Change the definition of the function "read" to:
Function Read() as FileIO.TextFieldParser
and change the declaration of "file" in sub main to:
Dim file as FileIO.TextFieldParser
That way the data type of the function and assignment match.

Calling a Sub or Function contained in a module using "CallByName" in VB/VBA

It is easy to call a function inside a classModule using CallByName
How about functions inside standard module?
''#inside class module
''#classModule name: clsExample
Function classFunc1()
MsgBox "I'm class module 1"
End Function
''#
''#inside standard module
''#Module name: module1
Function Func1()
MsgBox "I'm standard module 1"
End Function
''#
''# The main sub
Sub Main()
''# to call function inside class module
dim clsObj as New clsExample
Call CallByName(clsObj,"ClassFunc1")
''# here's the question... how to call a function inside a standard module
''# how to declare the object "stdObj" in reference to module1?
Call CallByName(stdObj,"Func1") ''# is this correct?
End Sub
I think jtolle's response addressed the question best - the small reference to Application.Run may be the answer. The questioner doesn't want to use simply func1 or Module1.func1 - the reason one would want to use CallByName in the first place is that the desired function.sub name is not known at compile time. In this case, Application.Run does work, e.g.:
Dim ModuleName As String
Dim FuncName As String
Module1Name = "Module1"
FuncName = "func1"
Application.Run ModuleName & "." & FuncName
You can also prepend the Project Name before the ModuleName and add another period ".".
Unfortunately, Application.Run does not return any values, so while you can call a function, you won't get its return value.
Although it is an old question and OP asked for CallByName in a standard module, the correct pieces of advice are scattered through answers and comments, and some may not be that accurate, at least in 2020.
As SlowLearner stated, Application.run DOES return a Variant, and in that way both branchs below are equivalent, except by handling errors, as commented around Horowitz's answer:
Dim LoadEnumAndDataFrom as Variant
'FunctionName returns a Variant Array
if fCallByName then
LoadEnumAndDataFrom = CallByName(ClassObj, "FunctionNameAtClass", VbMethod)
else
'After moving back function for a standard module
LoadEnumAndDataFrom = Application.Run("StandardModuleName" & "." & "FunctionNameAtStandard")
endif
I actually just did this above and had no errors at all, tested in Word, Excel and Access, and all return the same Array.
Unfortunately, there is an exception: Outlook's object Model is too protected and it does not have the Run method.
CallByName works only with class objects.
If your subroutine is in a standard module, you can do this:
Sub Main()
Module1.Func1
End Sub
If it's a function, then you'll probably want to capture the return value; something like this:
Sub Main()
Dim var
var = Module1.Func1
End Sub
Modules in VB6 and VBA are something like static classes, but unfortunately VB doesn't accept Module1 as an object. You can write Module1.Func1 like C.Func1 (C being an instance of some Class1), but this is obviously done by the Compiler, not at runtime.
Idea: Convert the Module1 to a class, Create a "Public Module1 as Module1" in your Startup-module and "Set Module1 = New Module1" in your "Sub Main".
Unfortunately it is not possible to prepend the ProjectName before the ModuleName and add another period "." In MS Word this throws a runtime error 438. The call is restricted to the use of simply ModuleName.ProcName.