Private Function pvCompareText(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
....
  If StrComp(val1, val2, vbTextCompare) = 1 Then
    pvCompareText = m_PRECEDE
  ElseIf StrComp(val1, val2, vbTextCompare) = -1 Then
    pvCompareText = m_FOLLOW
  End If
End Function

Private Function pvCompareText(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
....
  If StrComp(val1, val2, vbTextCompare) = 1 Then
    pvCompareText = m_PRECEDE
  Else Then
    pvCompareText = m_FOLLOW
  End If
End Function

Private Function pvGetItemText(ByVal hwnd As Long, ByVal lParam As Long) As String
  Dim nRet As Long
  With m_uLVI
    .mask = LVIF_TEXT
    .iSubItem = m_lColumn
    .pszText = Space(MAX_LVMSTRING)
    .cchTextMax = Len(.pszText)
  End With
  nRet = SendMessage(hwnd, LVM_GETITEMTEXT, lParam, m_uLVI)
  pvGetItemText = Left$(m_uLVI.pszText, nRet)
End Function

Private Function pvGetItemText(ByVal hwnd As Long, ByVal lParam As Long) As String
  Dim nRet As Long
  With m_uLVI
    .mask = LVIF_TEXT
    .iSubItem = m_lColumn
    .pszText = Space(MAX_LVMSTRING)
    .cchTextMax = Len(.pszText)
  End With
  nRet = SendMessage(hwnd, LVM_GETITEMTEXT, lParam, m_uLVI)
  pvGetItemText = Left$(m_uLVI.pszText, nRet)
End Function

Private Function pvGetItemText(ByVal hwnd As Long, ByVal lParam As Long) As String
Dim lIdx   As Long
Dim a(261) As Byte
Dim lLen   As Long
Dim m_uLVI_LNG As LV_ITEM_LNG
    With m_uLVI_LNG
        .mask = LVIF_TEXT
        .pszText = VarPtr(a(0))
        .cchTextMax = UBound(a)
        .iSubItem = m_lColumn
    End With
    lLen = SendMessage(hwnd, LVM_GETITEMTEXT, lParam, m_uLVI_LNG)
    pvGetItemText = Left$(StrConv(a(), vbUnicode), lLen)
End Function

Private Type LV_ITEM_LNG
  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 m_hMem1 As Long
Private m_hMem2 As Long
Private m_uLVI_LNG1 As LV_ITEM_LNG
Private m_uLVI_LNG2 As LV_ITEM_LNG
Public Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" _
 (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

Public Function Sort(ByVal hListView As Long, ByVal Column As Integer, ByVal SortOrder As eSortOrderConstants, ByVal SortType As eSortTypeConstants) As Boolean
...
    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_LNG1
        .mask = LVIF_TEXT
        .iSubItem = m_lColumn
        .pszText = m_hMem1
        .cchTextMax = MAX_LVMSTRING
      End With
      With m_uLVI_LNG2
        .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)
...
      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
    SendMessage hwnd, LVM_GETITEMTEXT, lParam, m_uLVI_LNG1
  Else
    SendMessage hwnd, LVM_GETITEMTEXT, lParam, m_uLVI_LNG2
  End If
End Sub

                ListView1(Index).ListItems(i).Tag = ListView1(Index).ListItems(i).SubItems(ColStructMas(Index).StartTimeN)
                ListView1(Index).ListItems(i).SubItems(ColStructMas(Index).SubmissionTimeN) = _
                  Format(ListView1(Index).ListItems(i).SubItems(ColStructMas(Index).SubmissionTimeN), "yyyymmddhhmmss")
...
ListView1(Index).SortOrder =
'либо
ListView1(Index).SortKey =
'ListView1(Index).Sorted = True 'ЭТО ДАЖЕ НЕ НУЖНО, т.к. сортируется при изменении .SortOrder / .SortKey

                ListView1(Index).ListItems(i).SubItems(ColStructMas(Index).SubmissionTimeN) = ListView1(Index).ListItems(i).Tag
                ListView1(Index).ListItems(i).Tag = ""

Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal lpString As Long) As Long
  val1 = DateFromString(SysAllocString(m_hMem1))

Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal lpString As Long) As String
  val1 = DateFromString(StrPtr(SysAllocString(m_hMem1)))

 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)))

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