SSDBGrid-Sort By Col

 Public Function SortSSDBGridByCol(ByRef pgrdSource As SSDBGrid, ByVal pgrdSelCol As Integer)
   
    Dim grdBak              As SSDBGrid
    Dim rsGrid              As ADODB.Recordset
    Dim intI                As Integer
    Dim intCol              As Integer

    Dim strColName          As String
   
    Dim strSelColCaption    As String
    Dim strSelColName       As String
    Dim strAddRow           As String

On Error GoTo Error_Handler

    '//
    'Use this function, please set grd.column().DateType
    'String :  DateType=Text
    'Numeric:  DateType=Double
    'Amount :  DateType=Currency   (12,345.03)
    '//
   
    Set grdBak = pgrdSource
    If pgrdSource.Rows = 0 Then
        Exit Function
    End If
   
    strSelColCaption = pgrdSource.Columns(pgrdSelCol).Caption
    strSelColName = UCase(Trim(pgrdSource.Columns(pgrdSelCol).Name))
   
    'Create Record set By ssdbgrid,each record type deply on grid.col.DateType
    Set rsGrid = New ADODB.Recordset
   
    For intI = 0 To pgrdSource.Columns.Count - 1
        strColName = UCase(Trim(pgrdSource.Columns(intI).Name))
        If pgrdSource.Columns(intI).DataType = 8 Then '8:Text
            rsGrid.Fields.Append strColName, adVarChar, 1024
        Else
            rsGrid.Fields.Append strColName, adDouble
        End If
    Next intI

    rsGrid.Open
   
    pgrdSource.Redraw = False
   
    pgrdSource.MoveFirst
   
    For intI = 0 To pgrdSource.Rows - 1
   
        rsGrid.AddNew
        For intCol = 0 To pgrdSource.Cols - 1
            'Amount:123,234.00
            If pgrdSource.Columns(intCol).DataType = 6 Then '6:Currency
                rsGrid.Fields(intCol).Value = Replace(Trim(pgrdSource.Columns(intCol).Value), ",", "")
            Else
                rsGrid.Fields(intCol).Value = Trim(pgrdSource.Columns(intCol).Value)
            End If
        Next intCol
       
        rsGrid.Update
        pgrdSource.MoveNext
    Next
   
    If InStr(1, strSelColCaption, Chr(&HA88B)) Then      '原先Desc-->ASC
        rsGrid.Sort = "[" & strSelColName & "]" & " Asc"
    ElseIf InStr(1, strSelColCaption, Chr(&HA1F8)) Then  '原先ASC -->Desc
        rsGrid.Sort = "[" & strSelColName & "]" & " Desc"
    Else
        rsGrid.Sort = "[" & strSelColName & "]" & " Asc"
    End If
   
    pgrdSource.RemoveAll
   
    Do While Not rsGrid.EOF
   
        For intCol = 0 To rsGrid.Fields.Count - 1
       
            If pgrdSource.Columns(intCol).DataType = 6 Then '6:Currency
                If intCol = 0 Then
                    strAddRow = Format(rsGrid.Fields(intCol).Value, "#,###.###")
                Else
                    strAddRow = strAddRow & vbTab & Format(rsGrid.Fields(intCol).Value, "#,###.###")
                End If
            Else
                If intCol = 0 Then
                    strAddRow = rsGrid.Fields(intCol).Value
                Else
                    strAddRow = strAddRow & vbTab & rsGrid.Fields(intCol).Value
                End If
            End If

        Next intCol
       
        pgrdSource.AddItem strAddRow
       
        rsGrid.MoveNext
    Loop
   
    For intCol = 0 To pgrdSource.Cols - 1
   
        If intCol = pgrdSelCol Then
       
            If InStr(1, strSelColCaption, Chr(&HA88B)) Then      '原先Desc-->ASC "▼"
                pgrdSource.Columns(pgrdSelCol).Caption = Replace(strSelColCaption, Chr(&HA88B), Chr(&HA1F8))
            ElseIf InStr(1, strSelColCaption, Chr(&HA1F8)) Then  '原先ASC -->Desc "▲"
                pgrdSource.Columns(pgrdSelCol).Caption = Replace(strSelColCaption, Chr(&HA1F8), Chr(&HA88B))
            Else
                pgrdSource.Columns(pgrdSelCol).Caption = strSelColCaption & Chr(&HA1F8)
            End If
        Else
       
            '将未选中行恢复Caption
            pgrdSource.Columns(intCol).Caption = Replace(Replace(pgrdSource.Columns(intCol).Caption, Chr(&HA88B), ""), Chr(&HA1F8), "")
        End If
    Next
   
    rsGrid.Close
    Set rsGrid = Nothing
   
    pgrdSource.Redraw = True
   
    Exit Function

Error_Handler:
    DBCloseRS rsGrid
    Set rsGrid = Nothing
    Set pgrdSource = grdBak
    pgrdSource.Redraw = True
    Err.Raise vbObject + 1024, "Sort SSDBGrid", Err.Description
End Function