I have a Sub that takes as argument a generic Object olObj. I want access a given property of the object, only if it exists.
I wrote the Function below to check for this.
I conceive also using error handling for this.
Is there any other way? (e.g., something like HasItemProperty which does not need to sweep through all ItemProperties and check one by one).
Function HasItemProperty(ByRef olObj As Object, ByVal ipname As String) As Boolean
HasItemProperty = False
Dim ips As ItemProperties
Set ips = olObj.ItemProperties
Dim iip As Integer
For iip = 0 To ips.Count - 1
Dim ip As ItemProperty
Set ip = ips.Item(iip)
Dim ipn As String
ipn = ip.Name
If (ipn = ipname) Then
HasItemProperty = True
Exit Function
End If
Next iip
End Function
So essentially you want to check if your object exposes a particular property, like olObj.SomeProperty?
Not in VBA. On the low level (C++, Delphi, etc.), you can call IDispatch::GetIDsOfNames. But why not simply access the property (olObj.SomeProperty) and handle the exception (on Error Resume Next, Err.Number / Err.Clear)?
You can try this, it's a bit inelegant that's for sure. If the property fetch fails then it sets the flag to false and goes about it's merry way.
You can toggle the comment for testProperty
Sub marine()
Dim testObj As Object
Dim propertyValid As Boolean
Dim testProperty As String
On Error GoTo PROPERR
Set testObj = Sheets(1)
testProperty = testObj.Name
'testProperty = testObj.ThisDoesNotExist
propertyValid = True
PROPRETURN:
Exit Sub
PROPERR:
propertyValid = False
GoTo PROPRETURN
End Sub
The Outlook object model doesn't provide any other way. You need to iterate over all properties in the collection to find the one you need.
Related
I have this task where i need to find some type of hybridshapes and collect them in a listbox
i have done that part, but i need to create it in such a way that when user selects a item from the list box respective hybridshape or object should get selected in catia
here is the image
here is the code
Option Explicit
Dim ODoc As Document
Dim opartdoc As PartDocument
Dim oPart As Part
Dim ohybs As HybridBodies
Dim ohyb As HybridBody
Dim ohybshps As HybridShapes
Dim ohybshp As HybridShape
Dim i As Integer
Dim j As Integer
Private Sub UserForm_Initialize()
Set ODoc = CATIA.ActiveDocument
Set opartdoc = CATIA.ActiveDocument
Set oPart = opartdoc.Part
End Sub
Private Sub ListBtn_Click()
Set ohybs = oPart.HybridBodies
Set ohyb = ohybs.Item("Shapes")
Set ohybshps = ohyb.HybridShapes
For i = 1 To ohybshps.Count
Set ohybshp = ohybshps.Item(i)
ShapeBox.AddItem ohybshp.Name
ShapeBox.Font.Bold = True
ShapeBox.Font.Size = 25
Next
End Sub
Private Sub SelectBtn_Click()
End Sub
i dont know much about listbox handling
how do i create link between items in listbox and objects in catia
thanks
Hi you could add this to your code and try it. Beware your solution is pretty fragile one. You should consider more robust checks for objects validation
The trick lies in ShapeBox.Value in Shapebox click event. The rest is just catia stuff. But this solution is not foolproof because if you have more shapes with same names it might not select the right one. I would prefer creating a collection where you store real object from sets and the passing these objects to selection
Private Sub ShapeBox_Click()
Call opartdoc.Selection.Clear
Call opartdoc.Selection.Add(opartdoc.Part.FindObjectByName(ShapeBox.Value))
End Sub
I have a DatePicker control on a worksheet. When I'm in the embedded code for the worksheet, I can access the control's value as follows:
Public Sub showValue()
Debug.Print Me.DTPicker21.value
End Sub
I would like to get the value from a module. Code here:
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.value
End If
Next
End Sub
When I run this, the obj.value triggers this error:
Object doesn't support this property or method
I checked the list of properties for obj using this procedure, and there is no value property. How can I get the date value that's been set in the DatePicker?
I don't know all of the details, but some of the OLEObjects require that you first access their Object property, then you can access other properties. I think the OLEObject serves as a container, then the "sub-object" is the actual object with which you want to interact. For example, if you run the following two lines of code, you will see that the first returns OleObject and the second returns DTPicker:
Debug.Print "Obj: " & TypeName(obj)
Debug.Print "Obj.Object: " & TypeName(obj.Object)
In your case, try the following code change to remove the error(note the Debug line):
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.Object.Value
End If
Next
End Sub
VBA6 code (Excel) worked great. Upgrade to Office 2010/VBA7, code breaks.
Using code from SO:
Determining whether an object is a member of a collection in VBA
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
obj = col(key)
Exit Function
err:
Contains = False
End Function
I get run-time error 5: Invalid procedure call or argument.
It doesn't make sense to me though because the error occurs on the obj = col(key) line which should be covered by the On Error GoTo err statement, but it stops.
Other If X exists in collection type solutions have the same problem.
Instead of fixing the broken code, what I really need is to be able to see if a record is already set for a collection, if that can be done some other (new) way in VBA7, that would solve the problem as well (I can dream).
I find that if I change specify an object, e.g., a worsheet, it works:
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim ws As Excel.Worksheet
On Error GoTo err
Contains = True
Set ws = col(key)
Exit Function
err:
Contains = False
End Function
I call it like this:
Sub test()
Dim ws As Excel.Worksheet
Dim coll As Collection
Set coll = New Collection
For Each ws In ThisWorkbook.Worksheets
coll.Add ws, ws.Name
Next ws
Debug.Print Contains(coll, ActiveSheet.Name)
Debug.Print Contains(coll, "not a worksheet name")
End Sub
I get True for the first call and False for the second.
I need to send data form one process to another.
Constraints :
Sender process is very expensive call.
It needs to be done using vbscipt.
For Sender process,this data transferring is an additional work.It shouldn't get affected much by this feature. There are around 1000 threads in a sender process in 4-5 mins.
Faster IPC is important.If it can be done asynchronoulsy it will be better.
I read about the named pipe.Is it possible to open a named pipe using vbscript .Also is there any other possible way considering the above constraints.
Using a named pipe is probably your only option from native VBScript. You could access any of the other IPC methods by writing a COM object in some other language.
A named pipe can be written to just like a file so you can use the FileSystemObject to open and read/write from a named pipe. The format for opening a named pipe is to use the format \\\\.\pipe\PipeName (Replace PipeName with the pipe's actual name).
So to write to a named pipe in VBScript:
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("\\.\pipe\PipeName", True)
a.WriteLine("This is a test.")
a.Close
Option Explicit
Dim g_receivedCallback
If WScript.Arguments.Named.Exists("NEW") Then
RunSecondInstance
Else
RunFirstInstance
End If
Sub RunSecondInstance()
Dim oSa, oWindow, oData, oCallback
' Search for the window
Set oSa = CreateObject("Shell.Application")
For Each oWindow In oSa.Windows
If TypeName(oWindow.Document) = "HTMLDocument" Then
If InStr(oWindow.Document.Title, "IPC Window") > 0 Then
' Get the data object, set a property and callback a method
Set oData = oWindow.GetProperty ("IPCData")
Set oCallback = oData.Callback
oData.Value = "Success!"
Call oCallback
End If
End If
Next
End Sub
Sub RunFirstInstance()
Dim oData, oIe, oWs
' Create a object to pass to a other script
Set oData = New IPCData
' Set a property to a callback method
Set oData.Callback = GetRef("MyCallback")
' Create a window and store the data in the window
Set oIe = CreateObject("InternetExplorer.Application")
oIe.Navigate "about:blank"
Do Until oIe.ReadyState = 4 : WScript.Sleep 5 : Loop
oIe.Document.Title = "IPC Window"
oIe.PutProperty "IPCData", oData
' Run second script instance
Set oWs = CreateObject("WScript.Shell")
oWs.Run "WSCRIPT.EXE """ & WScript.ScriptFullName & """ /NEW"
' Wait for callback from second script
Do Until g_receivedCallback = True : WScript.Sleep 5 : Loop
' Display received data
MsgBox oData.Value
' Close ie
oIe.Quit
End Sub
Sub MyCallback()
g_receivedCallback = True
End Sub
Class IPCData
Private m_callback
Public Property Get Callback()
Set Callback = m_callback
End Property
Public Property Set Callback(ByVal v)
Set m_callback = v
End Property
Private m_value
Public Property Get Value()
If IsObject(m_value) Then
Set Value = m_value
Else
Value = m_value
End If
End Property
Public Property Let Value(ByVal v)
m_value = v
End Property
Public Property Set Value(ByVal v)
Set m_value = v
End Property
End Class
this outlines what i am trying to do.
this is not working for me, and it is unclear why.
thank you in advance for any and all help.
Sub mySub()
dim myDict as Dictionary
myDict=new Dictionary
myDict=myFunc()
End Sub
Function myFunc()
dim myDict2
set myDict2 = new Dictionary
'some code that does things and adds to myDict2'
myFunc=myDict2
End Function
You'll need to use the SET keyword anytime you are assigning an object instead of a value:
Sub mySub()
dim myDict as Dictionary
set myDict = myFunc()
End Sub
Function myFunc() as Dictionary
dim myDict2 as Dictionary
set myDict2 = new Dictionary
'some code that does things and adds to myDict2'
set myFunc=myDict2
End Function
Your original code was also creating myDict as a new Dictionary object, then immediately replacing it with a different one. You can just skip that step.
I see that this is an old question, but the post AND solution helped me figure this out, and I took it to the next level. It was a small leap. Thank you!
How about converting your function that populates the dictionary with process names and IDs so it returns a dictionary object? Then it is a simple task of populating a sheet with the dictionary contents, which I learned to do from a blog. I wish I had the author's name but the link is included.
Sheet1 was assumed of course. Customize however you wish. Again this was a small leap from what both of you posted. Absolutely brilliant work guys, thank you!
Sub Test_AllRunningApps()
Dim apps As Dictionary
Set apps = AllRunningApps()
'Populate a sheet with a dictionary - http://exceldevelopmentplatform.blogspot.com/2018/05/vba-writing-dictionaries-to-worksheet.html
Sheet1.Cells(1, 1).Resize(apps.Count, 1).Value2 = Application.Transpose(apps.Keys)
Sheet1.Cells(1, 2).Resize(apps.Count, 1).Value2 = Application.Transpose(apps.Items)
Set apps = Nothing
End Sub
'Similar to: http://msdn.microsoft.com/en-us/library/aa393618%28VS.85%29.aspx
Public Function AllRunningApps() As Dictionary
Dim strComputer As String
Dim objServices As Object, objProcessSet As Object, Process As Object
Dim oDic As Object, oDic2 As Object, a() As Variant
Set oDic = CreateObject("Scripting.Dictionary")
strComputer = "."
Set objServices = GetObject("winmgmts:\\" _
& strComputer & "\root\CIMV2")
Set objProcessSet = objServices.ExecQuery _
("Select Name, ProcessID FROM Win32_Process", , 48)
For Each Process In objProcessSet
If Not oDic.exists(Process.Name) Then
oDic.Add Key:=Process.Properties_("Name").Value, Item:=Process.Properties_("ProcessID").Value
End If
Next
Set AllRunningApps = oDic
Set objProcessSet = Nothing
Set oDic = Nothing
End Function