I have a ListView control set up in details mode with 5 columns. It is populated by code using the following subroutine:
For j = 0 To 14
cmd = New OleDbCommand("SELECT TeacherName, ClassSubject, BookingDate, BookingPeriod FROM " & SchemaTable.Rows(i)!TABLE_NAME.ToString() & " WHERE (((BookingDate)=" & Chr(34) & Date.Today.AddDays(j) & Chr(34) & ") AND ((UserName)=" & Chr(34) & user & Chr(34) & "));", cn)
dr = cmd.ExecuteReader
Dim itm As ListViewItem
Dim itms(4) As String
While dr.Read()
itms(0) = dr(0)
itms(1) = SchemaTable.Rows(i)!TABLE_NAME.ToString()
itms(2) = dr(1)
itms(3) = dr(2)
itms(4) = dr(3)
itm = New ListViewItem(itms)
Manage.ManageList.Items.Add(itm)
End While
Next
Note that this is not the full routine, just the bit that populated the grid.
Now I need to retrieve data from the ListView control in order to delete a booking in my database. I used the following code to retrieve the content of each column:
ManageList.SelectedItems(0).Text
But it only seems to work on index 0. If I do:
ManageList.SelectedItems(3).Text
I get this error:
InvalidArgument=Value of '3' is not
valid for 'index'. Parameter name:
index
I'm pretty much stumped, it seems logical to me that index 1 will point to the 2nd column, index 2 to the 3rd etc, as it's 0 based?
Any help would be appreciated, thanks.
When you say ManageList.SelectedItems(3).Text, you're asking it for the forth item selected in your list, not the forth column of the item selected.
See MSDN
EDIT: Think of it this way: ManageList.SelectedItems(0)=itms, which is a string array. The following example shows how you can access the forth array value of the selected array in the list:
Dim itms() As String = ManageList.SelectedItems(0)
If itms.Length>3 Then
itms(3).DoWhatever
End If
The SelectedItems method returns the selected ListViewItem(s). To access the individual columns within, use the SubItems property.
Note from the documentation:
The first subitem in the
ListViewItem.ListViewSubItemCollection
is always the item that owns the
subitems. When performing operations
on subitems in the collection, be sure
to reference index position 1 instead
of 0 to make changes to the first
subitem.
Related
I have been using the below code for years to generate communications. I am adapting it to new requirements.
The code grabs data from Sharepoint/MS Teams to filter then copy into a new tab. The code calls an email template that contains placeholders in multiple tables which includes a banner. By using strings it replaces the value of cells with the placeholder.
The data has bullet points and is in paragraphs. However when the email is generated, it has the data in one block as one continuous line.
I tried inserting line breaks but without success.
My latest iteration is to use a replace function, after the loop through the string arrays.
.HTMLBody = replace(.htmlBody, ";", "<BR>")
I put ";" at the end of a line when I want to go the next line.
However, whilst the <BR> does add the line break, it changes the font to Times New Roman and puts in a lot HTML garbage when the email is generated. I suspect is it is from the "<BR>".
The odd thing is when I add a debug.print onto .htmlbody it shows the font and line breaks are correct, with or without the second replace function.
I also tried to change "<BR>" with CHR(10) and vbnewline and other permutations.
I have not included the code that declares the outlook objects and the location of the email template as that works.
Sub ImportSPData() 'Source the Sharepoint data
Dim objMyList As ListObject
Dim objWksheet As Worksheet
Const strSPServer As String = "https://xxxx.xxxxx.xxx.com/teams/xxxx/_vti_bin" 'Sharepoint Url
Const LISTNAME As String = "{1574AC55-E21A-41D2-9EEC-891CFEC69BF6}" 'Sharepoint list code - where the data is inputted
Const VIEWNAME As String = "{34D4B58A-D4C6-4190-9248-896D062543C6}" 'Sharepoint View code - The specific view of the list
Set objWksheet = Worksheets("ImportData") 'Where the data is exported to
objWksheet.Select
If ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
objWksheet.Cells.Select
Selection.ClearContents
Range("A1").Select
Set objMyList = objWksheet.ListObjects.Add(xlSrcExternal, Array(strSPServer, LISTNAME, VIEWNAME), False, , Range("A1")) 'where the above export lands
Range("A1").Select
ActiveSheet.ListObjects(1).Unlist
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
Call applyAutoFilter 'sets up the stage. However when the "Import Data" tab is viewed, the line breaks and bullet points are missing.
End Sub
Sub Replace()
'Populate replacement strings from sharepoint. .Range("xx") corresponds to the column containing new text.
Dim repNumberText As String: repNumberText = dataSheet.Range("f2").Value
Dim repTitleText As String: repTitleText = dataSheet.Range("I2").Value
Dim repSummaryText As String: repSummaryText = dataSheet.Range("B2").Value
Dim repImpactText As String: repImpactText = dataSheet.Range("C2").Value
Dim repUnderwayText As String: repUnderwayText = dataSheet.Range("D2").Value
Dim repCompletedText As String: repCompletedText = dataSheet.Range("E2").Value
Dim repUpdateText As String: repUpdateText = dataSheet.Range("G2").Value
repSummaryText = "<p>" & repSummaryText & "</p>"
repCompletedText = "<p>" & repCompletedText & "</p>"
Dim replaceStrings() As Variant
Dim replaceWithStrings() As Variant
'Replacement Array, replaceStrings are the text placeholders in the email templates, replacewithstrings are the variables assigned above.
replaceStrings = Array("NumberText", "TitleText", "SummaryText", "ImpactText", "UnderwayText", "CompletedText", "UpdateText")
replaceWithStrings = Array(repNumberText, repTitleText, repSummaryText, repImpactText, repUnderwayText, repCompletedText, repUpdateText)
Dim currentItem As String
Dim currentReplaceItem As String
Dim i As Integer
i = UBound(replaceStrings)
Dim j As Integer
j = 0
With msgFile
Today = Format(Now(), "DDDD DD MMM yyyy")
'Dim HtmlBody As String
'Loop through arrays and replace text
Do Until j = i + 1
.HtmlBody = Replace(.HtmlBody, replaceStrings(j), replaceWithStrings(j))
j = j + 1
Loop
'Replace subject texts.\
' .Subject = "Communications"
' .Subject = Today
.Subject = Replace(.Subject, "NumberText", repNumberText)
.Subject = Replace(.Subject, "TitleText", repTitleText) & " " & "-" & " " & Today
.Display
It is not clear when and where all these customizations are made. Also it is not clear where the original item comes form. Anyway, keep in mind that you need to prepare a well-formed HTML document to be able to set up the HTMLBody property correctly. Even if Outlook handles cases where only some tags are provided, it is better to deal with a fully-formed HTML document.
The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.
Hello again community,
After I got so much help from you with my last Problem, that promted me to rework the entire code in a more efficient manner, I would like to ask two more questions regarding the same Project.
(1) I would like to implement a live-filter in my listbox CGList1, which is connected to the textbox SearchCGList1. Whenever someone types in the textbox, the results in the listbox should be adjusted. I found this Article on your website, as well as this Article 3 on an external Webpage. However, due to my very limited skills, I have not been able to adapt it properly. More later.
(2) After multiple items from the same listbox CGList1 have been transferred to the second listbox CGList2 via a button (which works like a treat), I would like to save them in the same cell (Range "BM") on my Worksheet Meta DB. For this problem I also used Google extensively and tried to adapt the findings (see links below) for my code - without success.
I hope that the Patient ones amongst you can help me out once again, in the knowledge that I am trying to learn as much as possible. My Problem is that for a lot of things, I simply do not know what to look for.
My preliminary code for Problem 1:
CGList1 and CGList2 have no code. They are populated in the Userform_Initialize sub via:
'Fill Material Groups Listbox1 dynamically
Dim cell As Range
Dim rng As Range
With ThisWorkbook.Sheets("Commodity Groups")
'Range to 500 in order to allow for further additions
Set rng = .Range("A2", .Range("A500").End(xlUp))
End With
Me.CGList1.ColumnWidths = "20;80"
For Each cell In rng.Cells
'Filter out blanks
If cell <> "" Then
With Me.CGList1
.AddItem cell.value
.List(.ListCount - 1, 1) = cell.Offset(0, 1).value
End With
End If
Next cell
I cannot just use .AddItem and then filter through the columns like you find in many examples online because it needs to be dynamic and there are many blanks in between the selection items on the Worksheet.
The buttons:
Private Sub addCGbutton_Click()
For i = 0 To CGList1.ListCount - 1
If CGList1.Selected(i) = True Then
'Copy only CG Name, not respective number/letter combination (only more work to cut out when working with it later)
CGList2.AddItem CGList1.List(i, 1)
End If
Next i
End Sub
'Delete selected Commodity Groups from List 2 for re-selection
Private Sub delCGbutton_Click()
Dim counter As Integer
counter = 0
For i = 0 To CGList2.ListCount - 1
If CGList2.Selected(i - counter) Then
CGList2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub
After a lot of trial and failure trying to adapt the linked approaches from other people, I tried something more simple:
Private Sub SearchCGList1_Change()
'Only show with textbox matching items in CGList1 (filter)
Dim strSQL As String
strSQL = "SELECT fieldname FROM table WHERE fieldname = "
strSQL = strSQL & "'" & Me!SearchCGList1 & "*'"
strSQL = strSQL & " ORDER BY fieldname;"
Me!SearchCGList1.RowSource = strSQL
End Sub
But without success.
Regarding Problem 2:
To save the multiple selections from CGList2 in Range BM on Worksheet "Meta DB", I toyed around a lot and my last try was:
Save multiple selections from Commodity Group List 2 to the same cell in Excel
Dim listItems As String, c As Long
With CGList2
For c = 0 To .ListCount - 1
If .Selected(c) Then listItems = listItems & .List(c) & ", "
Next c
End With
Range("BM") = Left(listItems, Len(listItems) - 2)
Usually, all my other UserForm entries are saved with a single command button in the following fasion:
Private Sub CommandButton21_Click()
'Application.ScreenUpdating = False
'Define all relevant WBs we will be working with
Dim wbInput As Workbook
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets("Meta DB")
Dim LastRow As Long
'Save Userform Inputs
With ws
.Activate
LastRow = ws.Range("A" & Rows.Count).End(xlUp).row + 1
.
.
Range("BK" & LastRow).value = Me.payinfo90
Range("BL" & LastRow).value = Me.payinfo90more
'Risk Management - Residual Information
Range("BM" & LastRow).value = Me.CGList2
Range("BN" & LastRow).value = Me.suppsince
.
.
End With
End Sub
Again, I thank everyone who took the time to read my post and answer with tips on what to improve.
Everyone have a great day.
Using a helper column with array formula.
So if say you had your data for the 1st list box in a1:a10 and the selection from this listbox is placed in D1, the 2nd complete listbox selections are in B1:B10, but not used, then in E1:E10, I have the following array formula filled down, so you would populate the 2nd listbox off the helper column E.
Beginning with
=INDEX($B$1:$B$10,SMALL(IF(LEFT($B$1:$B$10,LEN($D$1))=$D$1,ROW($B$1:$B$10),""),ROWS($E$1:$E1)),1)
Containing
=INDEX($B$1:$B$10,SMALL(IF(NOT(ISERR(SEARCH($D$1,$B$1:$B$10))),ROW($B$1:$B$10)),ROWS($E$1:E1)),1)
You need to press CTRL SHIFT and ENTER for array formula.
I am trying to store the value of a listbox (Actual_Polygon_Area) that has been generated via row source query. Each time I run the script my message box tells me that the value of the listbox is null and I suspect it's caused by the row source. The suspected listbox is named Actual_Polygon_Area and the field I am trying to store it in is Polygon_Area within the table FS_Actual_Polygon.
Private Sub Actual_Polygon_Save_Click()
If IsNull(Actual_Polygon_Year) Then
MsgBox "Please enter a year in which this polygon received treatment"
Actual_Polygon_Year.SetFocus
ElseIf IsNull(Actual_Polygon_Season) Then
MsgBox "Please enter the season in which this polygon received treatment"
Actual_Polygon_Season.SetFocus
ElseIf IsNull(Actual_Polygon_Treatment) Then
MsgBox "Please select the treatment type that was completed in this polygon."
Actual_Polygon_Treatment.SetFocus
ElseIf IsNull(Actual_Polygon_Notes) Then
MsgBox "Please write a short summary regarding treatment goals and objectives."
Actual_Polygon_Notes.SetFocus
ElseIf IsNull(Actual_Polygon_Area) Then
MsgBox "Polygon Area is null, please enter a value"
Actual_Polygon_Area.SetFocus
Else
Dim MyConnection As ADODB.Connection
Set MyConnection = CurrentProject.Connection
Dim rsFS_Actual_Polygon As ADODB.Recordset
Set rsFS_Actual_Polygon = New ADODB.Recordset
If IsNull(PolygonNo) Then
'add
rsFS_Actual_Polygon.Open "select * from FS_Actual_Polygon where PolygonNo= " & Actual_Polygon_ID & " and Treatment_Season= '" & Actual_Polygon_Season & "' and Treatment_Type= '" & Actual_Polygon_Treatment & "' and Project_Name = '" & Actual_Polygon_Project_Name & "' and Polygon_Area = " & Actual_Polygon_Area.Value & " and Treatment_Year = " & Actual_Polygon_Year, _
MyConnection, adOpenDynamic, adLockOptimistic
If Not rsFS_Actual_Polygon.EOF Then
MsgBox "The combination of Polygon ID, treatment-year, treatment-season, and treatment type already exist. Please check the combination."
Actual_Polygon_Year.SetFocus
Else
With rsFS_Actual_Polygon
.AddNew
![PolygonID] = Actual_Polygon_ID
![Project_Name] = Actual_Polygon_Project_Name
![Polygon_Area] = Actual_Polygon_Area.Value
![Treatment_Year] = Actual_Polygon_Year
![Treatment_Season] = Actual_Polygon_Season
![Treatment_Type] = Actual_Polygon_Treatment
![Polygon_Notes] = Actual_Polygon_Notes
.Update
End With
Actual_Polygon_Record.Requery
Actual_Polygon_New_Click
End If
I can post the rest of the code if necessary, I just didn't want to post a huge chunk.
You can use the .ItemsSelected and .ItemData methods to find and pass the value of the selected row from the listbox to your table.
This is a fairly typical use of the listbox control, and is a little easier than dealing with a multi-select control, but is still a bit cumbersome. You will need to create a For Each...Next loop to collect the row number of the selected row in your listbox and save to a variable. Then use that variable as the argument of the .ItemData method to return the bound column value for that selected row.
This MSDN article should have everything you need.
EDIT: While the above solution works for multi and single select listboxes, there is a more expedient way for single select listboxes:
Dim i as Integer
i = Me!Actual_Polygon_Area.ListIndex
If i = -1 Then
MsgBox "No item has been selected"
Exit Sub
End If
'Do above prior to `WITH` loop
...'Then in your `WITH` loop:
![Polygon_Area] = Actual_Polygon_Area.ItemData(i)
This is the code sample:
Set rs = Nothing
Set rs = New ADODB.Recordset
qry = "select maincategoryid,MCategoryName from mainCATEGORY"
rs.Open qry, Cn, adOpenDynamic, adLockReadOnly
If rs.EOF = False Then
Do Until rs.EOF
maincatddl.AddItem rs!MCategoryName, Val(rs!maincategoryid)
catddl.ItemData(catddl.NewIndex) = Val(rs!maincategoryid)
rs.MoveNext
Loop
End If
It's giving me "error invalid property array index". I have string type main category id.
Not possible directly. However, you could create an array to hold your strings, and the ListIndex of the selected item in the ComboBox will correspond to the index of the string.
Dim MainCatStrings() As String
Dim CurrIndex as long
CurrIndex = 0
Set rs = Nothing
Set rs = New ADODB.Recordset
qry = "select maincategoryid,MCategoryName from mainCATEGORY"
rs.Open qry, Cn, adOpenDynamic, adLockReadOnly
'ReDim the array to set equal to record count
ReDim MainCatStrings(rs.RecordCount)
If rs.EOF = False Then
Do Until rs.EOF
maincatddl.AddItem rs!MCategoryName
'Add the category ID to the string array
MainCatStrings(CurrIndex) = rs!maincategoryid
'Set the item data to the index value in string array
catddl.ItemData(catddl.NewIndex) = CurrIndex
CurrIndex = CurrIndex + 1
rs.MoveNext
Loop
End If
Hope this helps
A couple of things wrong here. First of all, this bit of code isn't very reusable, since you are trying to add the contents of the recordset into the Combo Box, but what if you wanted to run this code again - you would get a whole load of duplicates. So really, you need to clear the contents of the Combo Box, e.g.
maincatddl.Clear
Set rs = Nothing
Set rs = New ADODB.Recordset
qry = "select maincategoryid,MCategoryName from mainCATEGORY"
rs.Open qry, Cn, adOpenDynamic, adLockReadOnly
If rs.EOF = False Then
Do Until rs.EOF
... but which one? Normally, when you see .AddItem(), the next line is .ItemData(.NewIndex). But you have two different names:, maincatddl and catddl.
maincatddl.AddItem rs!MCategoryName, Val(rs!maincategoryid)
catddl.ItemData(catddl.NewIndex) = Val(rs!maincategoryid)
The balance of probabilities is that you intended maincatddl for the second line. You have obviously misunderstood the second parameter of the AddItem() method, Index. It looks as if you think this is meant to be user-defined integer, like the value of the ItemData() property. But Index is actually the position you want the new item to appear in the list. It may seem to work, assuming that Index is in the range (0 to .ListCount).
Unless you want the item to appear in a certain order, this line should be ammended to:
maincatddl.AddItem rs!MCategoryName
maincatddl.ItemData(maincatddl.NewIndex) = Val(rs!maincategoryid)
And incidentally, if you are using a lot of pairs of lines following this pattern, I would recommend you write a procedure to encapsulate this behaviour.
rs.MoveNext
Loop
End If
Normally ItemData of ComboBox and ListBox must be only Long Positive Or 0.
The simplest way for add other types of ItemData is using Collection.
In sample below ItemData of ComboBox and ListBox can have following types:
Long negative, String, any VB6 control (Image as sample ), any Object of VB6 (Form as sample).
Source.
I suggest using the Codejock controls for VB6. I use them for years in my company.
The ListBox and ComboBox ItemData and Tag properties from them are Variant and then they support strings as well as objects.
I am new to VB.I have a policy no. combobox in VB which populates after I enter first four digits of the policy no.However, if I continue to type the number it overwrites what I have already typed and wipes out the dropdown list, as if selecting for the new 4 numbers I typed.I Want to acheive a scenario where I will enter the first 4 numbers to populate the dropdown after that as i go on entering the policyno the values in the dropdown list get searched.
E.G:Policy number: 969003648, as I type 9690 the drop down is filled in with the policy no's starting from 969000001, now as I go on typing the values as 969003 etc the searched values gets limited to the policy no's having 969003 as starting values...Please assist
My code:
Private Sub PolicyNo_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Or KeyCode = 8 Then
Me.PolicyNo.value = ""
Else
If Len(Me.PolicyNo.Text) >= 4 Then
Me.PolicyNo.RowSource = ""
Call ReloadPolicyNo(Nz(Me.PolicyNo.Text, ""))
Function ReloadPolicyNo(sPolicyNo As String)
Me.PolicyNo.RowSource = "SELECT Inventory.PolicyNo FROM Inventory " & _
"WHERE Left(Inventory.PolicyNo," & Len(Me.PolicyNo.Text) & ") = '" & Me.PolicyNo.Text & "' order by Inventory.PolicyNo"
End Function
Why don't you use the Textchanged event on your combo box to get what is currently in the combobox ?
Example
'THIS FIRES WHEN TEXT IS ENTERED INTO THE COMBOBOX
Private Sub ComboBox1_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox1.TextChanged
'GET VALUE IN COMBOBOX
Dim enteredText As String = ComboBox1.Text
Dim strSelect As String = "select * from table where field like = '" & enteredText & "'%"
'load COMBO BOX HERE
End Sub
It's better to use DataView here , I declared DataTable as class Variable.
Dim dt as DataTable
Fetched All the data from database and bind it to declared DataTable, This DataTable further added to DataView and use RowFilter to filter DataView.
Compay_Type is one of the column in my DataTable Below code will filter DataView and bind data where column Company_Type=1
Dim dvComp As New DataView(dt)
dvComp.RowFilter = "Company_Type=1"
ComboBox1.DisplayMember = "CompanyName"
ComboBox1.ValueMember = "CompanyID"
ComboBox1.DataSource = dvComp
To remove Filter just use dvComp.RowFilter = Nothing