MODERATOR NOTICE: This topic has also been posted on other sites and may already have an answer elsewhere. Please take this into consideration when answering this question
- QuoteThis is one of the ways I tried to delete the listboxDisplay More
I can't select the listbox in Developer mode and it doesn't delete using the shapes delete method.Further it doesn't show up in the objects pane or with the object select.
Also, I really need vba code to delete it as this will be deleted and remade any time the code runs.
Here is the complete code:
Code- Sub GetComponents(wsName As Worksheet, Analysis As Variant)
- Dim Conn1 As New ADODB.Connection
- Dim Cmd1 As New ADODB.Command
- Dim Errs1 As Errors
- Dim Rs1 As New ADODB.Recordset
- Dim i As Integer
- Dim AccessConnect As String
- Dim x As String
- Dim ORACLE_USER_NAME As String
- Dim ORACLE_PASSWORD As String
- Dim sql As String
- Dim myPort As String
- Dim myHost As String
- Dim OracleSID As String
- Dim SERVICE_NAME As String
- Dim rcnt As Integer
- Dim lstHeight As Integer
- Dim objOLE As OLEObject, objListBox As msforms.ListBox
- Dim obj As OLEObject
- Dim Records As Variant
- ' Error Handling Variables
- Dim errLoop As Error
- Dim strTmp As String
- With Conn1 .CursorLocation = adUseClient
- End With
- 'Set Sheet1 RowHeight
- wsName.Rows("1:1").RowHeight = 24
- x = wsName.Range("C2")
- ORACLE_USER_NAME = "xxxxxxxxxxxxxx"
- ORACLE_PASSWORD = "xxxxxxxxxxxx"
- myPort = "1521"
- myHost = "xxxxxxxx"
- OracleSID = "10.6.4.142"
- SERVICE_NAME = "xxxxxxxxxxx"
- 'Connection String
- AccessConnect = "Provider=OraOLEDB.Oracle;" & _
- "Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)(Host=" & myHost & ")(Port=1521))(CONNECT_DATA=" & _
- " (SERVICE_NAME=" & SERVICE_NAME & ")));User ID=" & ORACLE_USER_NAME & ";Password=" & ORACLE_PASSWORD
- On Error GoTo AdoError ' Full Error Handling which traverses Connection object
- Conn1.ConnectionString = AccessConnect
- Conn1.Open
- Cmd1.ActiveConnection = Conn1
- sql = ""
- sql = sql & "SELECT DISTINCT LWPROD.COMPONENT.NAME"
- sql = sql & " FROM LWPROD.COMPONENT"
- sql = sql & " INNER JOIN lwprod.ANALYSIS ON COMPONENT.ANALYSIS = ANALYSIS.NAME"
- sql = sql & " WHERE ANALYSIS.NAME = '" & Analysis & "'"
- sql = sql & " ORDER BY 1"
- Cmd1.CommandText = sql
- Set Rs1 = Cmd1.Execute
- 'Rs1.CursorLocation = adUseServer
- Rs1.MoveFirst
- Do Until Rs1.EOF rcnt = rcnt + 1 Rs1.MoveNext
- Loop
- rcnt = rcnt 'Rs1.RecordCount
- lstHeight = rcnt * 17
- Rs1.MoveFirst
- wsName.Range("A1:A" & rcnt).CopyFromRecordset Rs1
- 'Remove current listbox object
- With objOLE .Delete
- End With
- Set objOLE = wsName.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, _
- DisplayAsIcon:=False, Left:=0, Top:=0, Width:=150, Height:=lstHeight) ' set some properties
- With objOLE ' these are properties of the container OLEObject, not the Listbox itself .Name = "lstComponents" .ListFillRange = "A1:A9" Set objListBox = .Object ' toggle visibility to ensure the control is clickable .Visible = False .Visible = True
- End With
- ' now we can set the listbox-specific properties
- With objListBox .MultiSelect = fmMultiSelectMulti .MatchEntry = fmMatchEntryComplete
- End With
- 'Close Connections
- Rs1.Close
- Conn1.Close
- Conn1.ConnectionString = ""
- Done:
- Set Rs1 = Nothing
- Set Cmd1 = Nothing
- Set Conn1 = Nothing
- 'Prompt
- MsgBox " Data Returned "
- Exit Sub
- AdoError:
- 'i = 1
- On Error Resume Next
- ' Enumerate Errors collection and display properties of
- ' each Error object (if Errors Collection is filled out)
- Set Errs1 = Conn1.Errors
- For Each errLoop In Errs1 With errLoop strTmp = strTmp & vbCrLf & "ADO Error # " & i & ":" strTmp = strTmp & vbCrLf & " ADO Error # " & .Number strTmp = strTmp & vbCrLf & " Description " & .Description strTmp = strTmp & vbCrLf & " Source " & .Source i = i + 1 End With
- Next
- End Sub
Thanks,
Jeff