Value from embedded ListBox - OLEObject

[krishnak]

I have a web Form with values, copied from SharePoint and pasted on an Excel spreadsheet. This has ListBoxes and TextBoxes with values. I want to extract the values from these controls and copy them to another worksheet. These are named from Control 23 to 57.
There is no problem in extracting the values from TextBoxes denoted as 'HTML Text ..' in the Properties.
I am using the following code:

val = ws.OLEObjects ("Control 33").Object.Value

But when I come to the ListBoxes, denoted as 'HTML Select..' in the Properties, the above code is raising an error. For example, if I run the code

val = ws.OLEObjects("Control 23").Object.Value

I get the error message "Object does not support this property or method".

How can I extract the selected value from the ListBox? Remember that this Form is copied and pasted from web. I tried to access this web Form by Excel directly, but I failed. Hence I have to go for this recourse.

Thanks in advance for any suggestion.

[Kenneth Hobs]

Post a short example workbook.

[krishnak]

In the TestWorksheet posted, 'Control 28' to 'Control 30' are the ListBoxes. 'Control 31' to 'Control 51' are the TextBoxes.

[Kenneth Hobs]

I don't have time to finish this just yet but here is most of it. It just needs to handle the cases where no value is in the list for an item. You will also have an issue with the HTMLSelect1 in that 12 is the month number for December.

Sub t()
MsgBox htmlSelectedValue(Sheet3.HTMLSelect1)
'MsgBox Sheet3.HTMLSelect3.Values
End Sub

Function htmlSelectedValue(h As HTMLSelect) As Variant
Dim s() As String, i As Integer
s() = Split(h.Object.Selected, ";")
i = PosInArray(True, s)
If i <> -1 Then htmlSelectedValue = Split(h.Object.Values, ";")(i - 1)
End Function

'If array is 0 based, 1 is returned if aValue matches anArray(0).
Function PosInArray(aValue, anArray)
Dim pos As Long
On Error Resume Next
pos = -1
pos = WorksheetFunction.Match(CStr(aValue), anArray, 0)
PosInArray = pos
End Function

[david000]

http://www.ozgrid.com/forum/showthread.php?t=83155

From Ozgrid - if you run this code in your test workbook you can get an idea of how to manipulate the controls on that sample. Run this code exactly the way you have it laid out and it puts it on a new worksheet.




Sub Test()
Dim txctrl As OLEObject, ws As Worksheet, wsNew As Worksheet
Set ws = ActiveSheet
Set wsNew = Worksheets.Add
wsNew.Cells(1, 1).Value = "TextBoxValue"
For Each txctrl In ws.OLEObjects
If txctrl.progID Like "*HTML:Text*" Then 'modify this line to include the comboboxes
wsNew.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = txctrl.Object.Value
End If
Next
End Sub

[krishnak]

david000 - Thanks for the reply.

I have no problem reading the values from 'TextBox' controls and pasting them on another worksheet.
My problem is with reading the values in the ListBoxes.

[Kenneth Hobs]

Seems to work ok.

Sub t()
Dim o As OLEObject
For Each o In Sheet3.OLEObjects
If o.progID = "Forms.HTML:Select.1" Then MsgBox o.Name & ": " & htmlSelectedValue(o)
Next o
'MsgBox htmlSelectedValue(Sheet3.HTMLSelect1)
'MsgBox htmlSelectedValue(Sheet3.HTMLSelect3)
End Sub

Function htmlSelectedValue(h As OLEObject) As Variant
Dim s() As String, i As Integer
s() = Split(h.Object.Selected, ";")
i = PosInArray(True, s)
If i <> -1 Then htmlSelectedValue = Split(h.Object.Values, ";")(i - 1)
End Function

'If array is 0 based, 1 is returned if aValue matches anArray(0).
Function PosInArray(aValue, anArray)
Dim pos As Long
On Error Resume Next
pos = -1
pos = WorksheetFunction.Match(CStr(aValue), anArray, 0)
PosInArray = pos
End Function

[krishnak]

Kenneth - Thanks for the code to retrieve the selected value.'Function to extract the item value of a ListBox (Single item Select)
Function SelectedValue(ole As OLEObject) As String
'Declare two arrays - one whether Selected (TRUE or FALSE)
'Second array for the actual values of the ListBox.
Dim strSel() As String, strVal() As String
Dim i As Long
On Error Resume Next

'This array will have TRUE or FALSE value - TRUE for Selected Items.
strSel = Split(ole.Object.Selected, ";")
'This array will hold all the values of the items.
strVal = Split(ole.Object.Values, ";")

'Find the object value where strSel value is TRUE.
For i = 0 To UBound(strSel)
If (str(i) = True) Then
SelectedValue = strVal(i)
End If
Next i

End Function

Since I am dealing with single item select, I customized the code as shown above. This can be extended for multi-select by modifying the Function (I hope so!).

The code is working in the specific instance I am working. I'd appreciate if any possible bugs are present and how we can improve the same.

[Kenneth Hobs]

I am not sure how a muti-select combobox would make sense in a form though a listbox with mult-select might make sense. While multi-select is possible, it would require a modification of the code but the concepts are the same. Selected property returns the semi-colon delimited string of True and False. The index values for True would then be obtained for use in the Values property to get the appropriate value for each selected item.