If lstrcmp(m_hMem1, m_hMem2) > 0 Then
    pvCompareText = m_PRECEDE
  Else
    pvCompareText = m_FOLLOW
  End If

     Format(str1 , "yyyymmddhhmmss")
     Format(str2 , "yyyymmddhhmmss")

Private Function pvCompareDate(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
  Dim val1 As Date
  Dim val2 As Date
  val1 = pvGetItemDate(hwnd, lParam1)
  val2 = pvGetItemDate(hwnd, lParam2)
  If (val1 > val2) Then
    pvCompareDate = m_PRECEDE
  ElseIf (val1 < val2) Then
    pvCompareDate = m_FOLLOW
  End If
End Function
Private Function pvGetItemDate(ByVal hwnd As Long, ByVal lParam As Long) As Date
...
  sText = Left$(m_uLVI.pszText, nRet)
  If (IsDate(sText)) Then pvGetItemDate = sText
End Function

m_hMem1 -> str1 as VB6 String
m_hMem2 -> str2 as VB6 String

 HRESULT VarDateFromStr(
   [in]  OLECHAR        *strIn,
   [in]  LCID           lcid,
   [in]  unsigned long  dwFlags,
   [out] DATE           *pdateOut
);

typedef struct {
...
  LPTSTR pszText;
  int    cchTextMax;

Private Function DateFromString(ByVal sDateIn As Long) As Date
    Dim hResult As Long
    Dim dtOut As Date
    hResult = VarDateFromStr(sDateIn, GetUserDefaultLCID(), LOCALE_NOUSEROVERRIDE, dtOut)
    Select Case hResult
        Case S_OK:
            DateFromString = dtOut

  val1 = DateFromString(m_hMem1) 'ошибка DISP_E_TYPEMISMATCH

  val1 = DateFromString(StrPtr(PtrToString(m_hMem1)))

  Set LItem = ListView1.ListItems.Add
  LItem.SubItems(1) = "Subitemtext" 'с любым итемом()
  ListView1.ListItems(1).Text = "text1" 'с любым итемом()

HRESULT VarDateFromStr(
  _In_   LPCOLESTR strIn,
  _In_   LCID lcid,
  _In_   ULONG dwFlags,
  _Out_  DATE *pdateOut
);

Private m_lColumn     As Long
Private m_PRECEDE     As Long
Private m_FOLLOW      As Long
Private m_hMem1 As Long
Private m_hMem2 As Long
Private m_uLVI_1 As LVITEM
Private m_uLVI_2 As LVITEM

Private Type LVITEM
  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
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private m_hMem1 As Long
Private m_hMem2 As Long
Private m_uLVI_1 As LVITEM
Private m_uLVI_2 As LVITEM

Public Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpW" _
 (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
 
'!psDateIn - указатель на ЮНИКОД -строку, содержащую дата-время
Private Declare Function VarDateFromStr Lib "oleaut32.dll" ( _
 ByVal psDateIn As Long, _
 ByVal lcid As Long, _
 ByVal uwFlags As Long, _
 ByRef dtOut As Date) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Public Function Sort(ByVal hListView As Long, ByVal Column As Integer, ByVal SortOrder As eSortOrderConstants, ByVal SortType As eSortTypeConstants) As Boolean
  Dim lRet As Long
  If SortType = [stDate] Then
    '1) создаем временный столбец и копируем туда "yyyymmddhhmmss"
    '2) везде стараемся использовать указатели
    '3) стараемся не разбрасываться памятью -единый адрес hMem
    '4) стараемся использовать W вместо A -юникод чуть быстрее
    '5) Используем DateFromString вместо CDate(String)
    '6) производим сортировку как текст по новому столбцу
    Dim iItemCount As Long
    Dim i As Long
    iItemCount = SendMessage(hListView, LVM_GETITEMCOUNT, 0, 0)
    If iItemCount = 0 Then Exit Function
    Dim lvc As LV_COLUMN
    lvc.mask = LVCF_WIDTH
    lvc.cx = 0
    m_lColumn = SendMessage(hListView, LVM_INSERTCOLUMN, _
     SendMessageLong(SendMessageLong(hListView, LVM_GETHEADER, 0, 0), HDM_GETITEMCOUNT, 0, 0), lvc)
    Dim hMem As Long
    hMem = GlobalLock(GlobalAlloc(&H40, MAX_LVMSTRING))
    Dim lvi_receive As LVITEM
    lvi_receive.mask = LVIF_TEXT
    lvi_receive.cchTextMax = MAX_LVMSTRING
    lvi_receive.pszText = hMem
    lvi_receive.iSubItem = Column
    Dim lvi_send As LVITEM
    lvi_send.mask = LVIF_TEXT
    lvi_send.iSubItem = m_lColumn
    For i = 0 To iItemCount - 1
      Call SendMessage(hListView, LVM_GETITEMTEXTW, i, lvi_receive)
      lvi_send.iItem = i
      lvi_send.pszText = StrPtr(Format$(DateFromString(hMem), "yyyymmddhhmmss"))
      Call SendMessage(hListView, LVM_SETITEMW, 0, lvi_send)
    Next
    GlobalFree hMem
  Else
    m_lColumn = CLng(Column)
  End If
  Select Case SortOrder
    Case soDefault
      m_PRECEDE = 1
      m_FOLLOW = -1
      lRet = SendMessageLong(hListView, LVM_SORTITEMSEX, hListView, AddressOf pvCompareIndex)
    Case soAscending, soDescending
      m_PRECEDE = SortOrder
      m_FOLLOW = -SortOrder
      'выделяем ДВЕ области памяти, куда будем копировать ВСЕ сравниваемые строки
      m_hMem1 = GlobalLock(GlobalAlloc(&H40, MAX_LVMSTRING))
      m_hMem2 = GlobalLock(GlobalAlloc(&H40, MAX_LVMSTRING))
      With m_uLVI_1
        .mask = LVIF_TEXT
        .iSubItem = m_lColumn
        .pszText = m_hMem1
        .cchTextMax = MAX_LVMSTRING
      End With
      With m_uLVI_2
        .mask = LVIF_TEXT
        .iSubItem = m_lColumn
        .pszText = m_hMem2
        .cchTextMax = MAX_LVMSTRING
      End With
      Select Case SortType
        Case [stString]
          lRet = SendMessageLong(hListView, LVM_SORTITEMSEX, hListView, AddressOf pvCompareText)
...
        Case [stDate]
          lRet = SendMessageLong(hListView, LVM_SORTITEMSEX, hListView, AddressOf pvCompareText)
          'удаляем подложный столбец
          Call SendMessageLong(hListView, LVM_DELETECOLUMN, m_lColumn, 0)
      End Select
    'освобождаем память
    GlobalFree (m_hMem1)
    GlobalFree (m_hMem2)
  End Select
  Sort = CBool(lRet)
End Function

Private Function pvCompareText(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
  'копируем в зарезервированную память
  pvGetItemText hwnd, lParam1, 1
  pvGetItemText hwnd, lParam2, 2
  If lstrcmp(m_hMem1, m_hMem2) > 0 Then
    pvCompareText = m_PRECEDE
  Else
    pvCompareText = m_FOLLOW
  End If
End Function

Private Sub pvGetItemText(ByVal hwnd As Long, ByVal lParam As Long, ByVal num As Long)
  If num = 1 Then
    Call SendMessage(hwnd, LVM_GETITEMTEXTW, lParam, m_uLVI_1)
  Else
    Call SendMessage(hwnd, LVM_GETITEMTEXTW, lParam, m_uLVI_2)
  End If
End Sub

Private Function DateFromString(ByVal sDateIn As Long) As Date
  Dim hResult As Long
  Dim dtOut As Date
  Const LOCALE_NOUSEROVERRIDE = &H80000000

  ' Do the conversion
  hResult = VarDateFromStr(sDateIn, GetUserDefaultLCID(), LOCALE_NOUSEROVERRIDE, dtOut)

  Select Case hResult
    Case S_OK:
      DateFromString = dtOut
...
  End Select
End Function

    Select Case m_SortOrder
      Case soAscending
        SetWindowLong m_hwndLV, GWL_STYLE, GetWindowLong(m_hwndLV, GWL_STYLE) Or Not LVS_SORTASCENDING And Not LVS_SORTDESCENDING
      Case soDescending
        SetWindowLong m_hwndLV, GWL_STYLE, GetWindowLong(m_hwndLV, GWL_STYLE) Or LVS_SORTDESCENDING And Not LVS_SORTASCENDING
    End Select