Solved

Help on sorting vbAccelaratoe Grid in Outlook 2007 VBA

Posted on 2012-04-09
22
744 Views
Last Modified: 2012-04-14
We place the sorting accordingly.  However, when the results are displayed, it is not really sorted.

This is what we have

 UserForm1.gridItemsFound.SortObject.Clear
 UserForm1.gridItemsFound.ColumnSortOrder(i_DATE) = CCLOrderAscending
 UserForm1.gridItemsFound.SortObject.SortColumn(i_DATE) = 1
 UserForm1.gridItemsFound.Sort

Please advice
0
Comment
Question by:rayluvs
  • 13
  • 8
22 Comments
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 37826021
OK - I am looking at this one too, tied in with the code I have already supplied you.

Stand By...

Chris
0
 
LVL 13

Accepted Solution

by:
Chris Raisin earned 450 total points
ID: 37826035
In the code I supplied at the end of the original question, I supplied the solution to this.

It seems a lot of your questions now stem from the fact you are using my original code supplied as an answerto your first question and not the final code supplied ( whc=ich is a vast improvement).

The solution to this one is in code like the following:

    If FilteredItems.Count > 0 Then
        'Start displaying filtered info requested
        UserForm1.gridItemsFound.Redraw = False
        UserForm1.gridItemsFound.Clear

        For nItem = 1 To FilteredItems.Count
          AddData FilteredItems(nItem), nType
        Next
        UserForm1.gridItemsFound.SortObject.Clear
        UserForm1.gridItemsFound.ColumnSortOrder(i_PROJECT) = CCLOrderAscending
        UserForm1.gridItemsFound.ColumnSortOrder(i_TASKS) = CCLOrderAscending
        UserForm1.gridItemsFound.SortObject.SortColumn(i_PROJECT) = 1
        UserForm1.gridItemsFound.SortObject.SortColumn(i_TASKS) = 2
        UserForm1.gridItemsFound.Sort
        UserForm1.gridItemsFound.Redraw = True
      Else
        DisplayEmptyGrid True

      End If

Open in new window



Perhaps you have left off a "redraw" ?

Cheers
Chris
0
 

Author Comment

by:rayluvs
ID: 37826066
You are correct, "UserForm1.gridItemsFound.Redraw = False" was missing.

But still doesn't sort.  

We want to sort by a Date instead of Project/Subject:

    UserForm1.gridItemsFound.SortObject.Clear
    UserForm1.gridItemsFound.ColumnSortOrder(i_DATE) = CCLOrderAscending
    UserForm1.gridItemsFound.SortObject.SortColumn(i_DATE) = 1
    UserForm1.gridItemsFound.Sort

The date is converted to string, like "2012-0409 7:59:00 PM" (haven't had the chance to actually convert the column to Date)

Am I missing something?
0
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 37826255
OK stand by.....
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37826290
In your column sort code ensure you have specified the type of sort depending on the column header. Look at the "date" column in the sort code below. Amend your code accordingly.

Cheers
Chris

Public Sub gridItemsFound_ColumnClick(ByVal lCol As Long)
Dim sTag As String
Dim i As Long


With gridItemsFound.SortObject
  .Clear
  .SortColumn(1) = lCol
  sTag = gridItemsFound.ColumnTag(lCol)
  If (sTag = "") Then
    sTag = "DESC"
    .SortOrder(1) = CCLOrderAscending
  Else
    sTag = ""
    .SortOrder(1) = CCLOrderDescending
  End If
  gridItemsFound.ColumnTag(lCol) = sTag
  Select Case gridItemsFound.ColumnKey(lCol)
    Case "", ""
      ' sort by icon:
      .SortType(1) = CCLSortIcon
    Case "date", "received", "sent"
      'date columns
      'sort by date:
      .SortType(1) = CCLSortDate
    Case Else
      ' sort by text:
      .SortType(1) = CCLSortString
  End Select
End With
UserForm1.MousePointer = fmMousePointerHourGlass
gridItemsFound.Sort
UserForm1.MousePointer = fmMousePointerDefault
End Sub

Open in new window

0
 

Author Comment

by:rayluvs
ID: 37826297
Sorry about the confusion.  The "Click" on the header sorts the Grid ok.  The problem we have is when the Grid is displayed initially.  When the user first enter the grid and searches for specific, the result is not sorted the columne we need; the Date column.
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37826307
You could change your code to:

 UserForm1.gridItemsFound.SortObject.Clear
    UserForm1.gridItemsFound.ColumnSortOrder(i_DATE) = CCLOrderAscending
    UserForm1.gridItemsFound.SortObject.SortColumn(i_DATE) = 1
    UserForm1.gridItemsFound.ColumnSortType(i_DATE) = CCLSortDate
    UserForm1.gridItemsFound.Sort

Open in new window

0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37826308
Make sure i_Date is defined as 1 and that the column you have the date in is column 1

Cheers
Chris
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37826342
The date fields in Outlook are of a special date format:

For example:
   "27/02/2008  2:47:56 PM" (using the setting is on the PC Internationalization settings)

Even though it is a date value in Outlook, and even though the grid accepts it as a date
there seems to be a conversion problem behind the data held in vDate.
(Probably at my end it is because the programmers of vbAccelerate's Grid forgot some places in the world have "dd/mm/yy" as their format.

Be that as it may, I successfully sorted by changing the code as follows in your "AddData" subroutine:

 .cell(nRow, i_TASKS).Text = vTasks
    .cell(nRow, i_TYPE).Text = vType
    .cell(nRow, i_FROM).Text = vFrom
    .cell(nRow, i_TO).Text = vTo
    .cell(nRow, i_EMAIL).Text = vEmail
    .cell(nRow, i_ID).Text = vId
    .cell(nRow, i_RECEIVED).Text = Format(vReceived, "yyyy/dd/mm hh:mm:ss")

Open in new window


Of course I am using the line:

                           vReceived = itm.ReceivedTime

to assign value to the vReceived variable.

Change your code accordingly and see what happens.

Of course the date is displayed differently,
I you still want it displayed as the way it appears in Outlook, I will have to pursue it further.

Please advise.

Cheers
Chris
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37826403
I have now changed my format of the field in the module AddData to:

      .cell(nRow, i_RECEIVED).Text = Format(vReceived, "yy/mm/dd  hh:mm:ss AMPM")

That seems to be the only format that works for the sorting to succeed.

Cheers
Chris
0
 

Author Comment

by:rayluvs
ID: 37826434
I replace as you have it, but still no sort.

I think your last entries ID: 37826342 and forward, pertains to a question we placed regarding dates.
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 13

Expert Comment

by:Chris Raisin
ID: 37828710
I have fixed the sorting date problem.

But first, what date field are you using "SentOn" or "ReceivedTime"?

Cheers
Chris
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37829424
I am assuming "ReceivedTime"

Y=There has been quite a bit of changing of code but here is my finished product which should do EVERYTHING you need (although you may need to tweak the column names/order of lines in "FillGrid"


I hope you find this helpful.  (Note: you can change the column size on the fly and the order of the columns and it will remember it all every time it runs).

If you are happy with this and it answers all your questions, then perhaps we can look at "V2"? (Although I would like that put as a separate question).

Cheers
Chris

Code in UserForm1:
Private Sub CommandButton1_Click()
  Dim nType As Integer
  If Len(Trim(UserForm1.txtSearch.Text)) > 0 Then
    If InStr(CommandButton1.Caption, "SUBJECTS") Then
      SearchForData ("SUBJECTS")
    Else
      SearchForData ("PROJECTS")
    End If
  End If
End Sub
Private Sub SearchForData(cType As String)
  Dim nType As Integer
  Select Case cType
    Case "SUBJECTS"
      CommandButton1.Caption = "Click for PROJECTS"
      UserForm1.Caption = "Search for SUBJECTS"
      nType = s_SUBJECTS
      'AdjustHeader "Subject"
    Case "PROJECTS"
      CommandButton1.Caption = "Click for SUBJECTS"
      UserForm1.Caption = "Search for PROJECTS"
      nType = s_PROJECTS
      'AdjustHeader "Project"
  End Select
  FillGrid nType
End Sub
Public Sub txtSearch_KeyDown(ByVal KeyCode As msforms.ReturnInteger, ByVal Shift As Integer)
  Dim nType As Integer
  Select Case KeyCode
    Case vbKeyReturn
      'UserForm1.MousePointer = fmMousePointerHourGlass
      'txtSearch.MousePointer = fmMousePointerHourGlass
      If InStr(Me.Caption, "SUBJECTS") > 0 Then
        nType = 1
      ElseIf InStr(Me.Caption, "PROJECTS") > 0 Then
        nType = 2
      End If
      FillGrid nType
      'UserForm1.MousePointer = fmMousePointerDefault
      'txtSearch.MousePointer = fmMousePointerDefault
    Case vbKeyTab
      UserForm1.gridItemsFound.SetFocus
    Case vbKeyEscape   'escape key
      'This will close down the grid
      UserForm_Unload
      End
  End Select
End Sub
Public Sub gridItemsFound_KeyPress(Keyascii As Integer)
  Select Case Keyascii
    Case vbKeyEscape   'escape key
      'This will close down the grid
       UserForm_Unload
       End
    Case vbKeyTab
      txtSearch.SetFocus
  End Select
End Sub

Private Sub gridItemsFound_DblClick(ByVal lrow As Long, ByVal lCol As Long)
  Dim cId As String
  cId = gridItemsFound.cell(lrow, i_ID).Text
  If Len(Trim(cId)) > 0 Then
    OpenEmail gridItemsFound.cell(lrow, i_ID).Text
  End If
End Sub
Private Sub gridItemsFound_Click(ByVal lrow As Long, ByVal lCol As Long)
  Dim cId As String
  cId = gridItemsFound.cell(lrow, i_ID).Text
  If Len(Trim(cId)) > 0 Then
    OpenEmail gridItemsFound.cell(lrow, i_ID).Text
  End If
End Sub
Private Sub UserForm_QueryClose(cancel As Integer, CloseMode As Integer)
  'Catches user closing the grid via the "X" in the title bar.
  If CloseMode <> 1 Then
    UserForm_Unload
  End If
End Sub
Private Sub UserForm_Activate()
  Dim nSelectedRow As Long
  Dim nSelectedCol As Integer
  Static bFormIsSetUp As Boolean
  
  'Only do this when the form is first created
  If Not bFormIsSetUp Then
    'First add blank columns do we can set up indexes
    gridItemsFound.Redraw = False
    UserForm1.Caption = GetSetting(Application.Name, "Setup", "FormCaption", "Search for SUBJECTS")
    txtSearch.Text = GetSetting(Application.Name, "Setup", "txtSearch", "")
    nSelectedRow = GetSetting(Application.Name, "Setup", "SelectedRow", 1)
    nSelectedCol = GetSetting(Application.Name, "Setup", "SelectedCol", 1)
    If Len(txtSearch.Text) > 0 Then
      If InStr(UserForm1.Caption, "SUBJECTS") > 0 Then
        SearchForData "SUBJECTS"
      ElseIf InStr(UserForm1.Caption, "PROJECTS") > 0 Then
        SearchForData "PROJECTS"
      End If
      If nSelectedRow = 0 Then
        'just in case there was no selected row at some stage
        nSelectedRow = 1
        nSelectedCol = 1
      End If
      If UserForm1.gridItemsFound.Rows > 0 Then
        UserForm1.gridItemsFound.SelectedRow = nSelectedRow
        UserForm1.gridItemsFound.SelectedCol = nSelectedCol
      End If
    End If
    gridItemsFound.Redraw = True
    bFormIsSetUp = True
  Else
    UserForm1.gridItemsFound.SetFocus  'returning from a read of some email
  End If
End Sub
Private Sub UserForm_Unload()
  Dim nCol As Integer
  With Me.gridItemsFound
    For nCol = 1 To .Columns
      SaveSetting Application.Name, "Setup", "ColOrder" + CStr(nCol), .ColumnOrder(nCol)
      SaveSetting Application.Name, "Setup", "ColWidth" + CStr(nCol), .ColumnWidth(nCol)
      SaveSetting Application.Name, "Setup", "txtSearch", txtSearch.Text
      SaveSetting Application.Name, "Setup", "FormCaption", UserForm1.Caption
      SaveSetting Application.Name, "Setup", "SelectedRow", UserForm1.gridItemsFound.SelectedRow
      SaveSetting Application.Name, "Setup", "SelectedCol", UserForm1.gridItemsFound.SelectedCol
    Next
  End With
End Sub

Public Sub gridItemsFound_ColumnClick(ByVal lCol As Long)
Dim sTag As String
Dim i As Long

With gridItemsFound.SortObject
  .Clear
  .SortColumn(1) = lCol
  sTag = gridItemsFound.ColumnTag(lCol)
  If (sTag = "") Then
    sTag = "DESC"
    .SortOrder(1) = CCLOrderAscending
  Else
    sTag = ""
    .SortOrder(1) = CCLOrderDescending
  End If
  gridItemsFound.ColumnTag(lCol) = sTag
  Select Case gridItemsFound.ColumnKey(lCol)
    Case "", ""  'change these for columns which contain just icons
      ' sort by icon:
      .SortType(1) = CCLSortIcon
    Case "date", "received", "sent"
      'date columns
      'must sort on string to allow correct formatting
      '(workaround at the moment)
      .SortType(1) = CCLSortString
    Case Else
      ' sort by text:
      .SortType(1) = CCLSortString
  End Select
End With
UserForm1.MousePointer = fmMousePointerHourGlass
gridItemsFound.Sort
HighLightRow 1
UserForm1.MousePointer = fmMousePointerDefault
End Sub

Open in new window



Code in Module51.bas
Option Explicit
Private Declare Function FindWindow _
                Lib "user32.dll" _
                Alias "FindWindowA" (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos _
                Lib "user32" (ByVal hwnd As Long, _
                              ByVal hwndInsertAfter As Long, _
                              ByVal x As Long, _
                              ByVal y As Long, _
                              ByVal cx As Long, _
                              ByVal cy As Long, _
                              ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Public Const HWND_BOTTOM = 1

Public Const s_SUBJECTS = 1
Public Const s_PROJECTS = 2

Public Const i_SUBJECT = 1
Public Const i_PROJECT = 2
Public Const i_TASKS = 3
Public Const i_TYPE = 4
Public Const i_RECEIVED = 5
Public Const i_FROM = 6
Public Const i_TO = 7
Public Const i_ID = 8
'Public lColIndex() As Long
Public FilteredItems As Object

Public Sub FindItems()
  Dim nRow As Integer

  UserForm1.txtSearch.SetFocus
  UserForm1.Label1.Caption = "0 Subjects Found"
  UserForm1.gridItemsFound.GridLines = True
  AddColumns
  DisplayEmptyGrid False
  'AdjustHeader "Subject"
  Session.Application.ActiveExplorer.Activate
  Session.Application.ActiveExplorer.WindowState = olMinimized
  UserForm1.Show

End Sub

Public Sub OpenEmail(cId As String)
  Dim nWnd As Long
  nWnd = FindWindow("ThunderDFrame", UserForm1.Caption)
  UserForm1.Hide
  Session.GetItemFromID(cId).GetInspector.Display

  With UserForm1.gridItemsFound
    If Not .SelectedRow = .Rows Then
      .SelectedRow = .SelectedRow + 1
    End If
  End With
  
  UserForm1.Show False   'modeless
  
  'Send the Userform to the back
  SetWindowPos nWnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Private Sub Addrows(nRows As Integer)
  Dim nRow As Integer

  For nRow = 1 To nRows
    UserForm1.gridItemsFound.AddRow
  Next

End Sub

'Public Sub AdjustHeader(cHeading As String)
'  UserForm1.gridItemsFound.ColumnHeader("SearchType") = cHeading
'End Sub

Public Sub FillGrid(nType As Integer)
  Dim olFolder    As Object
  Dim folderItems As Object
  Dim sorteditems As Object
  Dim strFilter   As String
  Dim itm         As Object
  Dim x           As Integer
  Dim str         As String
  Dim nFound      As Long
  Dim nItem       As Integer
  Dim cLblCaption As String
  Dim cScheme(2)  As String
  'only getting mail which is received
  Set olFolder = Application.Session.GetDefaultFolder(olFolderInbox)
  Set folderItems = olFolder.Items

  'First display an empty grid then
  'stop screen from updating while data is added to screen
  DisplayEmptyGrid False
  UserForm1.gridItemsFound.Redraw = False

  If Len(Trim(UserForm1.txtSearch.Text)) > 0 Then
    If nType <= s_PROJECTS Then
      cScheme(s_PROJECTS) = "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Project"
      'cScheme(s_PROJECTS) = "urn:schemas:httpmail:project"
      cScheme(s_SUBJECTS) = "urn:schemas:httpmail:subject"
      strFilter = "@SQL=" & Chr(34) & cScheme(nType) & Chr(34) & " like " & "'%" & Trim(UserForm1.txtSearch.Text) & "%'"
      Set FilteredItems = olFolder.Items.Restrict(strFilter)
      
      If FilteredItems.Count > 0 Then
        UserForm1.gridItemsFound.Clear
        For nItem = 1 To FilteredItems.Count
          AddData FilteredItems(nItem), nType
        Next
        UserForm1.gridItemsFound.SortObject.Clear
        UserForm1.gridItemsFound.ColumnSortOrder(i_RECEIVED) = CCLOrderDescending
        UserForm1.gridItemsFound.SortObject.SortColumn(i_RECEIVED) = 1
        'The type must be CClSortString to ensure formatting works correctly
        UserForm1.gridItemsFound.SortObject.SortType(i_RECEIVED) = CCLSortString
        UserForm1.gridItemsFound.Sort
      Else
        DisplayEmptyGrid True
      End If
      HighLightRow 1
      If UserForm1.gridItemsFound.Rows > 0 Then
        UserForm1.gridItemsFound.SelectedCol = nType
        UserForm1.gridItemsFound.RowVisible(1) = True
      End If
    Else
      DisplayEmptyGrid True
    End If
    'update the indicator of number of records found
    nFound = FilteredItems.Count
  Else
    nFound = 0
    DisplayEmptyGrid True
  End If
  
  cLblCaption = CStr(nFound)

  Select Case nType

    Case s_SUBJECTS
      UserForm1.Label1.Caption = cLblCaption + " Subject" + IIf(nFound <> 1, "s", "") + " found"

    Case s_PROJECTS
      UserForm1.Label1.Caption = cLblCaption + " Project" + IIf(nFound <> 1, "s", "") + " found"

  End Select
  For x = 1 To 2
    'clicking twice to ensure the latest date is at the top
    UserForm1.gridItemsFound_ColumnClick i_RECEIVED
  Next
  SelectAndFocusInputLine
  
  ''Now show the screen updated and refreshed
  UserForm1.gridItemsFound.Redraw = True

End Sub
Public Sub HighLightRow(nNewRow As Long)
  'we use this sub to de-selectr any selected cells then
  'highlight the top row
  Dim nRow As Long
  Dim nCol As Integer
  With UserForm1.gridItemsFound
    .Redraw = False
    For nRow = 1 To .Rows
      For nCol = 1 To .Columns
        If .CellSelected(nRow, nCol) Then
          .CellSelected(nRow, nCol) = False
        End If
      Next
    Next
    If .Rows > 0 Then
      .SelectedRow = nNewRow
    End If
    .Redraw = True
  End With
End Sub
Private Sub DisplayEmptyGrid(bShowNoFind As Boolean)
  Dim x As Integer
  
  With UserForm1.gridItemsFound
    .Redraw = False
    .Clear
    Addrows 10
    .GridLines = True
    If Len(Trim(.cell(1, 1).Text)) = 0 And bShowNoFind Then
      HighLightRow 1
      .cell(1, 1).Text = "No records found for requested search"
      SelectAndFocusInputLine
    End If

    .Redraw = True

  End With

End Sub

Private Sub SelectAndFocusInputLine()
  UserForm1.txtSearch.SelStart = 0
  UserForm1.txtSearch.SelLength = Len(UserForm1.txtSearch.Text)
  UserForm1.txtSearch.SetFocus
End Sub

Private Sub AddData(itm As Object, nType As Integer)
  Dim lrow        As Long, lCol As Long, lIndent As Long
  Dim max         As Integer
  Dim vProject    As String
  Dim vSubject    As String
  Dim vType       As String
  Dim vTasks      As String
  Dim vFrom       As String
  Dim vTo         As String
  Dim vCategories As String
  Dim vId         As String
  Dim vReceived   As String  'must be as string to enable correct formatting
  Dim vSentOn     As String
  Dim nRow        As Long
  Dim nItem       As Integer
  

  With UserForm1.gridItemsFound

    'First add your columns if they are not already there
    If UserForm1.gridItemsFound.Columns = 0 Then
      AddColumns
  
    End If

    'Then add your row
    .AddRow

    'Lastly add your data
    'First any special fields added to outlook
    For nItem = 1 To itm.UserProperties.Count
      Select Case LCase(itm.UserProperties.Item(nItem).Name)
        Case "project"
          vProject = itm.UserProperties.Item(nItem).value
        Case "task"
          vTasks = itm.UserProperties.Item(nItem).value
        Case "type"
          vType = itm.UserProperties.Item(nItem).value
      End Select
    Next
    
    'then the standard fields
    vSubject = Trim(itm.Subject)
    vCategories = itm.Categories
    vFrom = itm.SenderName
    vId = itm.EntryID


    'If this is an OUTWARD email we need to ignore the error!
    On Error GoTo skipReceived
    vReceived = Format(itm.ReceivedTime, "yyyy/mm/dd hh:mm:ss AMPM")
skipReceived:
    On Error GoTo 0
    
    nRow = .Rows

    .cell(nRow, i_PROJECT).Text = vProject
    .cell(nRow, i_SUBJECT).Text = vSubject
    .cell(nRow, i_TASKS).Text = vTasks
    .cell(nRow, i_TYPE).Text = vType
    .cell(nRow, i_FROM).Text = vFrom
    .cell(nRow, i_TO).Text = vTo
    .cell(nRow, i_ID).Text = vId
    .cell(nRow, i_RECEIVED).Text = vReceived
    'COLORISATION of rows (if desired)
    'For lrow = 1 To .Rows
    '  For lCol = 1 To .Columns

    '    'Demonstrating multiple forecolor and backcolor for cells
    '    If (lrow Mod 35) = 0 Then
    '      If (lCol = 4) Then
    '        .CellBackColor(lrow, lCol) = &HCC9966
    '      Else
    '        .CellBackColor(lrow, lCol) = &HEECC99
    '
    '      End If
    '
    '    ElseIf (lrow Mod 2) = 0 Then
    '      .CellForeColor(lrow, lCol) = &HFF&
    '
    '    End If
    '
    '  Next lCol
    'Next lrow

  End With

End Sub

Private Sub AddColumns()
  Dim nCol As Integer

  With UserForm1.gridItemsFound
    .Redraw = False
    'first columns header will be adjusted while code is running
    .AddColumn vKey:="Subject", sheader:="Subject", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=400
    .AddColumn vKey:="Project", sheader:="Project", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=50
    .AddColumn vKey:="Task", sheader:="Task", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=50
    .AddColumn vKey:="Type", sheader:="Type", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=50
    .AddColumn vKey:="Received", sheader:="Received", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=20
    .AddColumn vKey:="From", sheader:="From", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=50
    .AddColumn vKey:="To", sheader:="To", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lcolumnwidth:=50
    .AddColumn vKey:="ID", sheader:="ID", lcolumnwidth:=20, bVisible:=False
    
    'restore the previous column widths defined by the user
    'Subject
    .ColumnOrder(1) = GetSetting(Application.Name, "Setup", "ColOrder1", 1)
    .ColumnWidth(1) = GetSetting(Application.Name, "Setup", "ColWidth1", 400)
    'Project
    .ColumnOrder(2) = GetSetting(Application.Name, "Setup", "ColOrder2", 2)
    .ColumnWidth(2) = GetSetting(Application.Name, "Setup", "ColWidth2", 50)
    For nCol = 3 To .Columns
      .ColumnOrder(nCol) = GetSetting(Application.Name, "Setup", "ColOrder" + CStr(nCol), nCol)
      .ColumnWidth(nCol) = GetSetting(Application.Name, "Setup", "ColWidth" + CStr(nCol), 50)
    Next
    
    SetColIndex
    
    .Redraw = True

  End With

End Sub

Private Sub SetColIndex()
  ReDim lColIndex(UserForm1.gridItemsFound.Columns)

  On Error Resume Next ' Because some columns may have been deleted through the UI
  With UserForm1.gridItemsFound
    lColIndex(i_SUBJECT) = .ColumnIndex("Subject")
    lColIndex(i_PROJECT) = .ColumnIndex("Project")
    lColIndex(i_TASKS) = .ColumnIndex("Tasks")
    lColIndex(i_TYPE) = .ColumnIndex("Type")
    lColIndex(i_RECEIVED) = .ColumnIndex("Received")
    lColIndex(i_FROM) = .ColumnIndex("From")
    lColIndex(i_TO) = .ColumnIndex("To")
  End With
  On Error GoTo 0
End Sub

Open in new window

0
 

Author Comment

by:rayluvs
ID: 37834506
We have found this to be even faster.  But I keep getting an error with the form.  Can you send me the UserFrom1?
0
 

Author Comment

by:rayluvs
ID: 37834560
The error I keep getting is when exiting the Form

---------------------------
vbAccelerator SGrid II Control
---------------------------
Run-time error '0'
---------------------------
OK  
---------------------------
0
 

Author Comment

by:rayluvs
ID: 37835237
Somehow solved it by exiting outlook, deleting the userform and re-importing it; its working.

However we are trying to understand the coding so we can tweak with it.  The collowing are the lines we are wondering what are they for.  Please just give a super brief of each line:


1. user32.dll
2. UserForm1.gridItemsFound.GridLines = True
3. .AddColumn vKey:="ID", sheader:="ID", lcolumnwidth:=20, bVisible:=False
4. .ColumnOrder(1) = GetSetting(Application.Name, "Setup", "ColOrder1", 1)
5. .ColumnWidth(1) = GetSetting(Application.Name, "Setup", "ColWidth1", 400)
6. .ColumnOrder(2) = GetSetting(Application.Name, "Setup", "ColOrder2", 2)
7. .ColumnWidth(2) = GetSetting(Application.Name, "Setup", "ColWidth2", 50)
8. .ColumnOrder(nCol) = GetSetting(Application.Name, "Setup", "ColOrder" + CStr(nCol), nCol)
9. lColIndex(i_SUBJECT) = .ColumnIndex("Subject")
10. Session.Application.ActiveExplorer.Activate
11. UserForm1.Caption = GetSetting(Application.Name, "Setup", "FormCaption", "Search for SUBJECTS")
12. txtSearch.Text = GetSetting(Application.Name, "Setup", "txtSearch", "")
13. nSelectedRow = GetSetting(Application.Name, "Setup", "SelectedRow", 1)
14. nSelectedCol = GetSetting(Application.Name, "Setup", "SelectedCol", 1)
15. UserForm1.MousePointer = fmMousePointerHourGlass
16. gridItemsFound.Sort
17. UserForm1.MousePointer = fmMousePointerDefault
0
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 37835853
Busy getting answers for you...

Stand By...

Cheers
Chris
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37836221
Well, here are some of your answers (it takes a while so I will do a few at a time)

1. User32.dll is a library which is situated in your "C:\Windows\System32" folder and contains lots of pre-written code (written probably in "C") which perofrms "low-level" operations within the Windows operating system (it would be too difficult/slow to do the code in VB6 or any other language apart from "C" or "Assembler").

If you perform a search on the web for "User32.dll" you would find many, many calls that are made through that library in different programs. I just noticed that line 7 should have "User32.dll" on it as well (the ".dll" is missing...that could be a reason for a problem, I am not sure whether the system assumes the ".dll" extension).

Do not worry about the rest of the declaration following "User32.dll". That is the REQUIRED statement if you are using that library. Declarations like these are always made at the top of a module before the first subroutine starts and always start with the words:
"Private Declare" or "Public Declare" and contain the name of a library, sometimes an alias" and sometimes extra code called parameters which the particular subroutine in the library might require. Programs calling these libraries always search the "Path" defined in the operating system (which always includes "C:\Windows\System32" and "C:\Windows\System"
by default. If you ever one day write a library (".DLL") yourself you would place it in the "System32" folder.

2. If you do not state "Gridlines=True" the the gridlines will not show (unless you have defined them to show when you designed the form). This line is in there for completeness of documentation to make sure that the programmer who has created the form (you) has set this property to "True" within the VB6/VBA form design.

3. AddColumn vKey:="ID", sheader:="ID", lcolumnwidth:=20, bVisible:=False
 This line is needed to add an "Invisible" column to the grid. It contains the "ID" that is  
 stored in every Outlook item and is a means of pointing to the exact message within
Outlook. I added this so that when the user double-clicks a row in the grid, the program will
get Outlook to display the email message (full screen), then, when the user closes/minimizes the email, the grid reappears (with the next row selected). The Grid actually hides behind the Outlook message which is accomplished by the line:
"SetWindowPos nWnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE" which is a call again to an external library contained in "User32.dll" and is defined at the top of the code.

4.ColumnOrder(1) = GetSetting(Application.Name, "Setup", "ColOrder", 1)
  The "GetSetting" function in VBA/VB6 allow you to retrieve from the computer's Registry a
  value which MAY have been stored there previously using the "SaveSetting" routine.
  This value once saved to the registry remains there (even after you have closed the
  computer down) and can be used every time your program runs.
  (Good for saving values at run time for use next time). The "old" was of doing this was to
  save to an ".INI" text file, but that is old-fashined and no longer used by most
  programmers.)
 
  The syntax for this is:
       
       <Value> = GetSetting(<AppName> as String, _
                                         <Section> as string, _
                                          <Key> as string, _
                                         [<Deafult>]) as String
       
    So ColumnOrder(1) = GetSetting(Application.Name, "Setup", "ColOrder1", 1) means:
       "Get the value stored in the Registry under the applications name, with a Section called
       "Setup" and a Key Called "ColOrder1", and if you cannot find it, set the value to 1
       
     I ALWAYS us the name "Setup" for the <Section> and the <Key> should be a name that
     easily equates to something recognisable in your program (such as "ColOrder1"  which
     easily is recognisable as the position in the columns for Column(1).
     If the user moves the column (by dragging it) this value would change as the program
     runs.

5.  ColumnWidth(1) = GetSetting(Application.Name, "Setup", "ColWidth1", 400)

      Similarly to answer 4 above, this gets the width of column 1 and if there is no value
     stored in the registry  the default value is 400 pizels.

     Of course the code I have supplied you allows the user to resize the columns if they so
     desire.

     If you need to ascertain a more correct "default" value for the width of the columns you
     could add the following code to display a column width on the form. Whenever you press
    "F2" the size of the currently column wil;l appear under the grid
     (press "F2" again to make it disappear)
 
 
     To achieve this add a label to UserForm1 called "lblColWidth" with a width of 120 and set  
     its "Visible" property to "False"
 
     Then amend the txtSearch_Keydown code to  include the "case vbKeyF2" line and its
     associated "ShowColWidth"              

Public Sub txtSearch_KeyDown(ByVal KeyCode As msforms.ReturnInteger, ByVal Shift As Integer)
  Dim nType As Integer
  Select Case KeyCode
    Case vbKeyReturn
      'UserForm1.MousePointer = fmMousePointerHourGlass
      'txtSearch.MousePointer = fmMousePointerHourGlass
      If InStr(Me.Caption, "SUBJECTS") > 0 Then
        nType = 1
      ElseIf InStr(Me.Caption, "PROJECTS") > 0 Then
        nType = 2
      End If
      FillGrid nType
      'UserForm1.MousePointer = fmMousePointerDefault
      'txtSearch.MousePointer = fmMousePointerDefault
    Case vbKeyF2
      ShowColWidth
    Case vbKeyTab
      UserForm1.gridItemsFound.SetFocus
    Case vbKeyEscape   'escape key
      'This will close down the grid
      UserForm_Unload
      End
  End Select
End Sub

Open in new window


   You also have to make a slight change to when the GRID senese a key being pressed, so
   change the  "KeyDown" code to include the "vbKeyF2 occurrence

Public Sub gridItemsFound_KeyDown(KeyCode As Integer, Shift As Integer, _
                                  bDoDefault As Boolean)
  Select Case KeyCode
    Case vbKeyEscape   'escape key
      'This will close down the grid
       UserForm_Unload
       End
    Case vbKeyF2
      ShowColWidth
    Case vbKeyTab
      txtSearch.SetFocus
  End Select
End Sub

Open in new window


   Add a new bit of code for the event "SelectionChange" into the code for the UserForm
 
Private Sub gridItemsFound_SelectionChange(ByVal lrow As Long, ByVal lCol As Long)
  If UserForm1.lblColWidth.visible Then
    ShowColWidth
  End If
End Sub

Open in new window


    Then finally add the code subroutine "ShowColWidth" to the "Module51.bas" file

Public Sub ShowColWidth(lCol As Long)
Dim cMsg As String
  With UserForm1.gridItemsFound
    cMsg = "Column Width: " + CStr(.ColumnWidth(lCol)) + ":"
    'we have to allow for the last "hidden" col for ID
    UserForm1.lblColWidth.Caption = cMsg
  End With
End Sub

Open in new window


  So now whenever you press "F2" the wiodth of the currently selected col will show and if
  you click on a different cell in the grid (in a new column) the width of the column will still
  show (until you press F2 again to majke it disappear)

  After playing around with the columns to determine the best default size, you can then
  change your "AddCol" code to define the size you want by default.

(Whew!)

I will add some more comments shortly to answer the rest of your questions.

Stand By (I need a rest) :-)

Cheers
Chris
0
 

Author Comment

by:rayluvs
ID: 37837751
Wow! Thank you very much!

But didn't see answers for questions

9. lColIndex(i_SUBJECT) = .ColumnIndex("Subject")
10. Session.Application.ActiveExplorer.Activate

Please advice
0
 
LVL 15

Assisted Solution

by:eemit
eemit earned 50 total points
ID: 37840413
Hi Ramante,
We place the sorting accordingly.  However, when the results are displayed, it is not really sorted.
This is what we have
 UserForm1.gridItemsFound.SortObject.Clear
 UserForm1.gridItemsFound.ColumnSortOrder(i_DATE) = CCLOrderAscending
 UserForm1.gridItemsFound.SortObject.SortColumn(i_DATE) = 1
 UserForm1.gridItemsFound.Sort

Try this:
  With UserForm1.gridItemsFound

      '--------------------------------------------------------
      ' Set in AddColumn Method or after That
      '--------------------------------------------------------
      ' ColumnSortType - A convenience property to use to maintain the the current column sort type
      ' ColumnFormatString - Gets/sets a format string used to format all of the text in the column
      ' e.g.:
      '.AddColumn vKey:="date", sHeader:="Date", eAlign:=ecgHdrTextALignLeft, bRowTextColumn:=False, lColumnWidth:=200, sFmtString:="dd/mm/yy hh:mm:ss AM/PM", eSortType:=CCLSortDate
      ' or
      '.ColumnFormatString("date") = "dd/mm/yy hh:mm:ss AM/PM"
      '.ColumnSortType("date") = CCLSortDate
      
      
      '--------------------------------------------------------
      ' Get Grid Column Index of the Column to sort
      '--------------------------------------------------------
      ' ColumnIndex - Gets the index of the column with the specified key.
      Dim nColIndex As Long
      Dim sColKey As String
      
      sColKey = "date"
      nColIndex = .ColumnIndex(sColKey)
      'NOTE: nColIndex is i_DATE from your Code (or lCol when sort called from Grid_ColumnClick)
      
      '--------------------------------------------------------
      'set up the SortObject
      '--------------------------------------------------------
      'For each sort column, you specify the SortColumn, SortOrder and SortType properties.
      
      
      '--------------------------------------------------------
      ' Clear SortObject
      '--------------------------------------------------------
      'Clear - Clears all columns from the sort object.
      .SortObject.Clear
      
      'ClearNongrouped - Clears only non-grouping sort rows from the sort object.
      .SortObject.ClearNongrouped
      
      
      '--------------------------------------------------------
      ' Add Column to SortObject
      '--------------------------------------------------------
      Dim nSortIndex As Long
      ' See if this column is already in the sort object:
      nSortIndex = .SortObject.IndexOf(nColIndex)
      If (nSortIndex = 0) Then
         ' If not, we add it:
         ' (To add a new column to the sort, set the index of the sort item to one greater than the current sort count.)
         nSortIndex = .SortObject.Count + 1
         'SortColumn - Gets/sets the column to sort by for the specified index.
         .SortObject.SortColumn(nSortIndex) = nColIndex  '*
      
      End If
      
      
      '--------------------------------------------------------
      ' Determine which sort order to apply:
      '--------------------------------------------------------
      'ColumnSortOrder - A convenience property to use to maintain the the current column sort Order
      'NOTE: we can use also ColumnTag
      'ColumnTag - Gets/sets an optional string value to associate with the column.
      '.ColumnSortOrder(i_DATE) = CCLOrderAscending
      .ColumnSortOrder(sColKey) = CCLOrderAscending
      ' But we need to set SortObject.SortOrder
      .SortObject.SortOrder(nSortIndex) = CCLOrderAscending
      ' NOTE: You can also set initially ColumnSortOrder after AddColumn Method
      ' and read it here e.g.:
      '.SortObject.SortOrder(nSortIndex) = .ColumnSortOrder(sColKey)
      ' and Toogle it e.g.: (you have that already using ColumnTag)
      'If .ColumnSortOrder(sColKey) = CCLOrderAscending Then
      '    .ColumnSortOrder(sColKey) = CCLOrderDescending
      'Else
      '    .ColumnSortOrder(sColKey) = CCLOrderAscending
      'End If

      
      '/ Wrong: with SortObject.SortColumn we add a SortColumn to SortObject
      '         i_DATE = 'ColumnIndex' of Column("date"),
      '         we need here 'SortIndex' (= .SortObject.Count + 1 when we add a SortColumn to SortObject)
      '         This need to be made first (see '*)
      '.SortObject.SortColumn(i_DATE) = 1
      '/
      
      '--------------------------------------------------------
      ' Set the type of sorting:
      '--------------------------------------------------------
      'SortType - Gets/sets the sorting type to use for the specified index. Sorting types include
      'numeric, string (case sensitive and insensitive), date (with various accuracy levels), icon,
      'colour, item data, selection and indentation.
      
      'NOTE: we read here SortType stored in Grid Column ColumnSortType property
      .SortObject.SortType(nSortIndex) = .ColumnSortType(nColIndex)
      
      
      '--------------------------------------------------------
      ' Sort Grid
      '--------------------------------------------------------
      'Sort - Sorts the grid data according to the options set up in the SortObject
      .Sort
      '--------------------------------------------------------
  End With

Open in new window


Test:
(locale: English (US), Short Date Format: M/D/YYYY)

Added Rows

"3/3/12 1:30:13 PM"
"3/3/12 10:32:38 AM"
"2/27/12 11:32:38 AM"
"1/4/12 12:12:12 AM"

.ColumnFormatString("date") = "dd/mm/yy hh:mm:ss AM/PM"

Result:
04/01/12 12:12:12 AM
27/02/12 11:32:38 AM
03/03/12 10:32:38 AM
03/03/12 01:30:13 PM
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 450 total points
ID: 37841034
I think eemit has posted to the wrong question here, we have settled this answer and now I am simply clarifying the meaning of different parts of the code (the sorting having been solved)

Continuing on with the answers to your questions, Ramante

  6. .ColumnOrder(2) = GetSetting(Application.Name, "Setup", "ColOrder2", 2)
       Refer to answer to Q4

  7. .ColumnWidth(2) = GetSetting(Application.Name, "Setup", "ColWidth2", 50)
       Refer to answer to Q5

  8. .ColumnOrder(nCol) = GetSetting(Application.Name, "Setup", "ColOrder" + _    
                                                           CStr(nCol), nCol)
       As per Q 4 and 6, but this time we are looping through all columns to get their stored
      order (as determined by the user)

   9. lColIndex(i_SUBJECT) = .ColumnIndex("Subject")
       This is where we set up the Index order of a column (refer to the documentation which is
       suppied by vbAccelerator)

 10. Session.Application.ActiveExplorer.Activate
       This is to  bring Outlook ("Application") to the fore so we can view the email.

  11. UserForm1.Caption = GetSetting(Application.Name, "Setup", "FormCaption",
                                                             "Search for SUBJECTS")
       We need this so we can determine what the LAST search was when the macro ran.
       It's purpose is to help the user if the search was on (say) Projects rather than the default
      "Subject"

12. txtSearch.Text = GetSetting(Application.Name, "Setup", "txtSearch", "")
     The last search performed is retrieved from the registry as per Q4

13. nSelectedRow = GetSetting(Application.Name, "Setup", "SelectedRow", 1)
      The last selectdRow is retrieved from the registry as per Q4

14. nSelectedCol = GetSetting(Application.Name, "Setup", "SelectedCol", 1)
      The last selectdCol is retrieved from the registry as per Q4

15. UserForm1.MousePointer = fmMousePointerHourGlass
      When long searches are in place, we need to change the "MousePointer" to one showing
      that something is happening, so we set it to the "HourGlass" used by Windows to    
      indicate that it is "busy". (The searcges are so fast, though, that you may not even notice
     a change in the MousePointer. The MousePOinter is applicable to various areas of the
     screen, so there is one for a Form, and sometimes even one for Grids or Textboxes.
     Applying it to a form also applies it to any controls contained in the form.

16. gridItemsFound.Sort
      Perfroma Sort on the grid accoding to the criteria set up in the SortObject

17. UserForm1.MousePointer = fmMousePointerDefault
     As per Q15, but this time we revert from "Busy" back to the user default MousePointer
     (Windows default is an arrow, but that can be changed by the user, so we use the default
     just in case the user has changed it).

So I think that covers everything now!

How are things at your end, Ramante?


Cheers
Chris
0
 

Author Comment

by:rayluvs
ID: 37847092
Just got a chance to escape... we are in closing.

Thanx for the explanations; great info!  You just helped us jump from point A to point B with breeze.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Resolve DNS query failed errors for Exchange
Outlook Free & Paid Tools
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now