|
[x]
Posted via EE Mobile
|
||
Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again. |
||
| 07/02/2009 at 12:21PM PDT, ID: 24540631 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: |
Sub launchpad()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim firstDate As Variant
Dim lastDate As Variant
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Add
Set xlsheet = xlbook.Worksheets(1)
firstDate = InputBox("Enter the First date for the required filter:", vbOKCancel, "Date Filter")
If firstDate = vbCancel Then Exit Sub
firstDate = CDate(firstDate)
lastDate = InputBox("Enter the Last date for the required filter:", vbOKCancel, "Date Filter")
If lastDate = vbCancel Then Exit Sub
lastDate = CDate(lastDate)
xlsheet.Range("A1") = "Folder"
xlsheet.Range("B1") = "First Date"
xlsheet.Range("C1") = "Last Date"
xlsheet.Range("D1") = "Mail Count"
xlsheet.Range("a2").Activate
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set myFolder = objNS.PickFolder
Call ProcessFolder(myFolder, xlsheet, CDate(firstDate), CDate(lastDate))
xlsheet.Select
xlsheet.Range("A1").Select
xlApp.Visible = True
xlsheet.Application.Range("a1").Activate
Set objNS = Nothing
Set myFolder = Nothing
Set xlsheet = Nothing
Set xlbook = Nothing
Set xlApp = Nothing
End Sub
Sub ProcessFolder(startFolder As MAPIFolder, dataRecord As Excel.Worksheet, first As Date, last As Date)
Dim objFolder As Outlook.MAPIFolder
Dim colitems As Outlook.Items
Dim strFilter As String
On Error Resume Next
' process all the items in this folder
strFilter = "[ReceivedTime] >= '" & Format(first + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "' and [ReceivedTime] <= '" & Format(last + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"
'strFilter = "[ReceivedTime] >= '" & Format(first + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"
Set colitems = startFolder.Items.Restrict(strFilter)
dataRecord.Application.ActiveCell.Offset(0, 0) = startFolder.FolderPath
dataRecord.Application.ActiveCell.Offset(0, 1) = first
dataRecord.Application.ActiveCell.Offset(0, 2) = last
dataRecord.Application.ActiveCell.Offset(0, 3) = colitems.Count
dataRecord.Application.ActiveCell.Offset(1, 0).Activate
' process all the subfolders of this folder
For Each objFolder In startFolder.Folders
Call ProcessFolder(objFolder, dataRecord, first, last)
Next
Set objFolder = Nothing
End Sub
|
Advertisement