Try this,
' This is the form
Option Explicit
Private Sub Form_Load()
Dim clmAdd As ColumnHeader
Dim itmAdd As ListItem
'Add two Column Headers to the ListView control
Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Name")
Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Date")
Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Age")
'Set the view property of the Listview control to Report view
ListView1.View = lvwReport
'Add data to the ListView control
Set itmAdd = ListView1.ListItems.Add(Text:="Joe")
itmAdd.SubItems(1) = "5-Jul-97"
itmAdd.SubItems(2) = 24
Set itmAdd = ListView1.ListItems.Add(Text:="Sally")
itmAdd.SubItems(1) = "4-Aug-97"
itmAdd.SubItems(2) = 9
Set itmAdd = ListView1.ListItems.Add(Text:="Bill")
itmAdd.SubItems(1) = "29-May-97"
itmAdd.SubItems(2) = 17
Set itmAdd = ListView1.ListItems.Add(Text:="Fred")
itmAdd.SubItems(1) = "17-May-97"
itmAdd.SubItems(2) = 31
Set itmAdd = ListView1.ListItems.Add(Text:="Anne")
itmAdd.SubItems(1) = "1-Jan-97"
itmAdd.SubItems(2) = 8
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As
MSComctlLib.ColumnHeader)
Static bSortOrder As Boolean
Dim iSortOrder As Integer
Dim strName As String
Dim lngItem As Long
Dim v As Variant
'Handle User click on column header
If ColumnHeader.Text = "Name" Then 'User clicked on Name header
iSortOrder = IIf(bSortOrder, lvwAscending, lvwDescending)
bSortOrder = Not bSortOrder
ListView1.SortKey = 0 'items in the list
ListView1.SortOrder = iSortOrder
ListView1.Sorted = True 'Use default sorting to sort the
ElseIf (ColumnHeader.Text = "Date") Then
gbSortOrder = Not gbSortOrder
ListView1.Sorted = False 'User clicked on the Date header
'Use our sort routine to sort
'by date
giDataType = SORT_BY_DATE
gnSubItemIndex = ColumnHeader.Index - 1
SendMessage ListView1.hWnd, _
LVM_SORTITEMS, _
ListView1.hWnd, _
AddressOf CompareData
'Refresh the ListView before writing the data
ListView1.Refresh
'Loop through the items in the List to print them out in
'sorted order.
'NOTE: You are looping through the ListView control because when _
'sorting by date the ListItems collection won't be sorted.
For lngItem = 0 To ListView1.ListItems.Count - 1
ListView_GetListItem lngItem, ListView1.hWnd, strName, v
Next
ElseIf (ColumnHeader.Text = "Age") Then
gbSortOrder = Not gbSortOrder
ListView1.Sorted = False 'User clicked on the Date header
'Use our sort routine to sort
'by date
SendMessage ListView1.hWnd, _
LVM_SORTITEMS, _
ListView1.hWnd, _
AddressOf CompareData
giDataType = SORT_BY_INTEGER
gnSubItemIndex = ColumnHeader.Index - 1
'Refresh the ListView before writing the data
ListView1.Refresh
'Loop through the items in the List to print them out in
'sorted order.
'NOTE: You are looping through the ListView control because when _
'sorting by date the ListItems collection won't be sorted.
For lngItem = 0 To ListView1.ListItems.Count - 1
ListView_GetListItem lngItem, ListView1.hWnd, strName, v
Next
End If
End Sub
' this is the module
Option Explicit
'Structures
Public Type POINT
x As Long
y As Long
End Type
Public Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINT
vkDirection As Long
End Type
Public Type LV_ITEM
mask As Long
iItem As Long
iSubItem As Long
State As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
'Constants
Private Const LVFI_PARAM = 1
Private Const LVIF_TEXT = &H1
Private Const LVM_FIRST = &H1000
Private Const LVM_FINDITEM = LVM_FIRST + 13
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48
'API declarations
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public gbSortOrder As Boolean
Public giDataType As Integer
Public gnSubItemIndex As Integer
' 1-integer, 2-long, 3-double, 4-currency, 5-date
Public Const SORT_BY_INTEGER As Integer = 1
Public Const SORT_BY_LONG As Integer = 2
Public Const SORT_BY_DOUBLE As Integer = 3
Public Const SORT_BY_CURRENCY As Integer = 4
Public Const SORT_BY_DATE As Integer = 5
'Module Functions and Procedures
'CompareData: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for date values.
Public Function CompareData(ByVal lngParam1 As Long, _
ByVal lngParam2 As Long, _
ByVal hWnd As Long) As Long
Dim strName1 As String
Dim strName2 As String
Dim v1 As Variant
Dim v2 As Variant
'Obtain the item names and dates corresponding to the
'input parameters
ListView_GetItemData lngParam1, hWnd, strName1, v1
ListView_GetItemData lngParam2, hWnd, strName2, v2
'Compare the dates
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
Select Case giDataType
Case SORT_BY_INTEGER: ' integer
CompareData = CompareIntegers(v1, v2)
Case SORT_BY_LONG: ' long
CompareData = CompareLongs(v1, v2)
Case SORT_BY_DOUBLE: ' double
CompareData = CompareDoubles(v1, v2)
Case SORT_BY_CURRENCY: ' currency
CompareData = CompareCurrencys(v1, v2)
Case SORT_BY_DATE: ' date
CompareData = CompareDates(v1, v2)
End Select
End Function
'GetItemData - Given Retrieves
Public Sub ListView_GetItemData(lngParam As Long, _
hWnd As Long, _
strName As String, _
v As Variant)
Dim objFind As LV_FINDINFO
Dim lngIndex As Long
Dim objItem As LV_ITEM
Dim baBuffer(32) As Byte
Dim lngLength As Long
'
' Convert the input parameter to an index in the list view
'
objFind.flags = LVFI_PARAM
objFind.lParam = lngParam
lngIndex = SendMessage(hWnd, LVM_FINDITEM, -1, VarPtr(objFind))
'
' Obtain the name of the specified list view item
'
objItem.mask = LVIF_TEXT
objItem.iSubItem = 0
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
VarPtr(objItem))
strName = Left$(StrConv(baBuffer, vbUnicode), lngLength)
'
' Obtain the modification date of the specified list view item
'
objItem.mask = LVIF_TEXT
objItem.iSubItem = gnSubItemIndex
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
VarPtr(objItem))
If lngLength > 0 Then
' dDate = CDate(Left$(StrConv(baBuffer, vbUnicode), lngLength))
v = Left$(StrConv(baBuffer, vbUnicode), lngLength)
End If
End Sub
'GetListItem - This is a modified version of ListView_GetItemData
' It takes an index into the list as a parameter and returns
' the appropriate values in the strName and dDate parameters.
Public Sub ListView_GetListItem(lngIndex As Long, _
hWnd As Long, _
strName As String, _
v As Variant)
Dim objItem As LV_ITEM
Dim baBuffer(32) As Byte
Dim lngLength As Long
'
' Obtain the name of the specified list view item
'
objItem.mask = LVIF_TEXT
objItem.iSubItem = 0
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
VarPtr(objItem))
strName = Left$(StrConv(baBuffer, vbUnicode), lngLength)
'
' Obtain the modification date of the specified list view item
'
objItem.mask = LVIF_TEXT
objItem.iSubItem = 1
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
VarPtr(objItem))
If lngLength > 0 Then
' dDate = CDate(Left$(StrConv(baBuffer, vbUnicode), lngLength))
v = Left$(StrConv(baBuffer, vbUnicode), lngLength)
End If
End Sub
Private Function CompareIntegers(v1, v2) As Long
Dim i1 As Integer
Dim i2 As Integer
i1 = CInt(v1)
i2 = CInt(v2)
If i1 < i2 Then
CompareIntegers = IIf(gbSortOrder, 2, 0)
ElseIf i1 = i2 Then
CompareIntegers = 1
Else
CompareIntegers = IIf(gbSortOrder, 0, 2)
End If
End Function
Private Function CompareLongs(v1, v2) As Long
Dim i1 As Long
Dim i2 As Long
i1 = CLng(v1)
i2 = CLng(v2)
If i1 < i2 Then
CompareLongs = IIf(gbSortOrder, 2, 0)
ElseIf i1 = i2 Then
CompareLongs = 1
Else
CompareLongs = IIf(gbSortOrder, 0, 2)
End If
End Function
Private Function CompareDoubles(v1, v2) As Long
Dim i1 As Double
Dim i2 As Double
i1 = CDbl(v1)
i2 = CDbl(v2)
If i1 < i2 Then
CompareDoubles = IIf(gbSortOrder, 2, 0)
ElseIf i1 = i2 Then
CompareDoubles = 1
Else
CompareDoubles = IIf(gbSortOrder, 0, 2)
End If
End Function
Private Function CompareCurrencys(v1, v2) As Long
Dim i1 As Currency
Dim i2 As Currency
i1 = CCur(v1)
i2 = CCur(v2)
If i1 < i2 Then
CompareCurrencys = IIf(gbSortOrder, 2, 0)
ElseIf i1 = i2 Then
CompareCurrencys = 1
Else
CompareCurrencys = IIf(gbSortOrder, 0, 2)
End If
End Function
Private Function CompareDates(v1, v2) As Long
Dim i1 As Date
Dim i2 As Date
i1 = CDate(v1)
i2 = CDate(v2)
If i1 < i2 Then
CompareDates = IIf(gbSortOrder, 2, 0)
ElseIf i1 = i2 Then
CompareDates = 1
Else
CompareDates = IIf(gbSortOrder, 0, 2)
End If
End Function
-----Original Message-----
From: Ned [mailto:nedashraf@h...]
Sent: Thursday, November 21, 2002 12:14 AM
To: professional vb
Subject: [pro_vb] How to sort Date column in ListView
Hi everyone,
As you all know in ListView every columns are in string format. I want to
sort the records if someone click on the date column header. Somehow its
build in function does not work. Any help is appreciated.
Ned
Soundex example worked beautiful thanx