using excel to sort outlook appointment items

MarAllenMike

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
I posted this at excel forums as well, but I was hoping someone could help me understand sorting outlook appointments. Outlook sorts them like this but when I use the macro, it sorts them like this. Notice it only does it when the subject has PennDOT in it.

This is my macro.
Code:
Sub LogThisWeeksAppointments()

    Dim myStart As Date
    Dim myEnd  As Date
    Dim oCalendar As Outlook.folder
    Dim oItems As Outlook.Items
    Dim oItemsInDateRange As Outlook.Items
    Dim oFinalItems As Outlook.Items
    Dim oAppt  As Outlook.AppointmentItem
    Dim strRestriction As String

    myStart = Now
    myEnd = DateAdd("D", 7, myStart)
    
'***Construct filter for the date range
    strRestriction = "[Start] >= '" & _
                     Format$(myStart, "mm/dd/yyyy hh:mm AMPM") _
                   & "' AND [End] <= '" & _
                     Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'"
    
    Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
    oItems.IncludeRecurrences = True
    
'***Restrict the Items collection for the date range
    Set oItemsInDateRange = oItems.Restrict(strRestriction)
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)
    
    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)
    
    Dim Signature As String
    Signature = objMsg.htmlBody
    
    Dim htmlBody As String
    Dim i      As Integer
    Dim AptStart As String, AptLocation As String, AptSubject As String
    
    Dim Weekof As String
    Weekof = Format(myStart, "MM/dd/YYYY")
    
'***Starts the HTML formatting for the body of the email with the Headers************
    htmlBody = "<html><body><h2>This Weeks Bid Projects</h2><table style=""width:55%""><tr><th>Bid Date</th><th>County</th><th>Project Description</th></tr>"
    
'***Starts Excel and opens "empty" book for log*********************
    Dim xlApp  As Object
    Set xlApp = CreateObject("excel.application")
    With xlApp
        .Visible = True
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    Dim wbBID  As Object
    Set wbBID = xlApp.Workbooks.Open("U:\Excel\EmptyBook.xlsm")
    xlApp.Application.Wait (Now + TimeValue("0:00:02"))
    
    Dim wsLog    As Worksheet
    Set wsLog = wbBID.Sheets("Sheet1")
    With wsLog.Range("A1:J1")
        .Value = Array("BID DATE", "LOCATION", "BID DESCRIPTION", "A", "", "R", "", "J", "", "D")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    
    wsLog.Range("E1, G1, I1").EntireColumn.ColumnWidth = 1
    wsLog.Range("D1, F1, H1, J1").EntireColumn.ColumnWidth = 4.43
    
    Dim StartPrime As Integer
    Dim StartDate As Date
    StartDate = myStart
    
    oItemsInDateRange.Sort "[Start]"
    
    i = 2
    For Each oAppt In oItemsInDateRange
    
        If DateDiff("D", StartDate, oAppt.Start) > 0 Then
            i = i + 1
        End If
        
        If InStr(1, oAppt.Subject, "Weekly Projects") > 0 Then GoTo NextAppt
            If InStr(1, oAppt.Subject, "Dropped") > 0 Then GoTo NextAppt
            
                wsLog.Cells(i, 1) = oAppt.Start
                wsLog.Cells(i, 2) = oAppt.Location
                With wsLog.Cells(i, 3)
                    .Value = oAppt.Subject
                    StartPrime = InStr(1, oAppt.Subject, "Prime", vbTextCompare)
                    If StartPrime <> 0 Then
                    .Characters(Start:=StartPrime, Length:=5).Font.Color = RGB(255, 0, 0)
                    .Interior.Color = RGB(242, 242, 242)
                    End If
                End With
            
            wsLog.Cells(i, 4).BorderAround ColorIndex:=1, Weight:=xlThin
            wsLog.Cells(i, 6).BorderAround ColorIndex:=1, Weight:=xlThin
            wsLog.Cells(i, 8).BorderAround ColorIndex:=1, Weight:=xlThin
            wsLog.Cells(i, 10).BorderAround ColorIndex:=1, Weight:=xlThin
            
        htmlBody = htmlBody + "<tr><td>" & oAppt.Start & "</td><td>" & oAppt.Location & "</td><td>" & oAppt.Subject & "</td></tr>"
        i = i + 1
        StartDate = oAppt.Start
NextAppt:
    Next
    htmlBody = htmlBody + "</table></body></html>"

    Weekof = Replace(Weekof, "/", "-")

    Dim LogFile As String
    LogFile = "M:\this week\" & Weekof & " Bidlist.xlsm"
    
    wsLog.Range("A1:C1").EntireColumn.AutoFit
    wsLog.Range("A1:B1").EntireColumn.HorizontalAlignment = xlCenter
   
    wbBID.SaveAs LogFile
    wbBID.Close
    
    With objMsg
        .Subject = "Projects for the Week of " & Weekof
        .htmlBody = htmlBody
        .Attachments.Add LogFile
        .Display
    End With
    
    xlApp.Quit
    Set xlApp = Nothing
    
End Sub
 
Outlook is listing by subject when the times are the same. The macro is only sorting by date - and without being able to see the events, it could be sorting within the same date & time by created date.
 
Try adding sort before or after recurrences - instead of after the results. (It may not make a difference but should be more efficient.)
oItems.Sort "[Start]"
oItems.IncludeRecurrences = True
 
Outlook is listing by subject when the times are the same. The macro is only sorting by date - and without being able to see the events, it could be sorting within the same date & time by created date.
I did try to see if they were sorted by creation time/date, but that's not the case. If I remove the "PennDOT:' part of the subject, they're all sorted by date, and then by subject the same way it shows in the Outlook pane. I did try to sort in different parts of the code, but the end result didn't change.
 
That is weird... you coyld remove the penndot from subject when you create the list -

replace(oAppt.Subject, "PennDot: ", "")
 
Similar threads
Thread starter Title Forum Replies Date
O Email not leaving Outbox when using Excel VBA to sync Outlook account Outlook VBA and Custom Forms 4
S Find a cell value in excel using outlook vba Using Outlook 1
N Export details to a excel spreadsheet using macros Using Outlook 0
D send email from Excel using outlook template Outlook VBA and Custom Forms 3
M Outlook 2013 won't convert Excel contacts into Outlook contacts using my custom form Using Outlook 3
M using Folders.Count in Excel Vba Outlook VBA and Custom Forms 8
M VBA Send Sales reports using .oft files, originate in Outlook or Excel? Using Outlook 5
B Using Outlook from Excel Outlook VBA and Custom Forms 2
W Using Excel UserForm from Open Workbook in Outlook VBA Outlook VBA and Custom Forms 5
H using VBA to edit subject line Outlook VBA and Custom Forms 0
e_a_g_l_e_p_i Need clarification on 2-Step Verification for Gmail using Outlook 2021 Using Outlook 10
e_a_g_l_e_p_i Outlook 2021 not letting me setup my Gmail using pop Using Outlook 1
Geldner Problem submitting SPAM using Outlook VBA Form Outlook VBA and Custom Forms 2
O How to find out the domain and server settings that my Outlook is using? Using Outlook 2
S Outlook 2019 Custom outlook Add-in using Visual Studio Outlook VBA and Custom Forms 0
D Outlook 2021 Using vba code to delete all my spamfolders not only the default one. Outlook VBA and Custom Forms 0
R Advise on using multiple instances of network files based on customers Outlook VBA and Custom Forms 8
HarvMan Using Emojis in Outlook 365 Using Outlook 3
T Outlook 2019 Not Using Auto Compete After Deletion of 365 Using Outlook 1
M USING INITIALS AS RECIPIENTS Using Outlook 1
T Outlook 2019 Using Gmail aliases in Outlook Using Outlook 6
M Saving emails using Visual Basic - Selecting folder with msoFileDialogFolderPicker Outlook VBA and Custom Forms 6
Z Import Tasks from Access Using VBA including User Defined Fields Outlook VBA and Custom Forms 0
justicefriends How to set a flag to follow up using VBA - for addressee in TO field Outlook VBA and Custom Forms 11
M Extract "Date sent" from emails (saved to folder using drag and drop) Outlook VBA and Custom Forms 1
I Outlook for Mac 2019 using on desktop and laptop IMAP on both need help with folders Using Outlook 1
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
H Stationery using between OL 2019 and OL 2010 Using Outlook 0
P Prevent Outlook 2016 from using DASL filter Using Outlook 4
O Calendar - Location: what happens when using my own way of entering locations Using Outlook 1
M Disable Contact Card Results when using "Search People" in Outlook Ribbon Using Outlook 7
K can't get custom form to update multiple contacts using VBA Outlook VBA and Custom Forms 3
S Outlook VBA How to adapt this code for using in a different Mail Inbox Outlook VBA and Custom Forms 0
pcunite Outlook 2019/O365 Build 13127.20408 errors when using MAPI calls Using Outlook 1
B Change Font and Font size using VBA Outlook VBA and Custom Forms 9
M Outlook 2013 reminder email by using Outlook vba Outlook VBA and Custom Forms 2
X Using Outlook 2013 and Outlook 365 Using Outlook 1
A Going to folder using shortcuts Using Outlook 3
A Outlook replies not using "delivered to" address in From Using Outlook 1
Terry Sullivan E-Mails Sent Using a Group Box Result in 70 Kickbacks Using Outlook 4
K Using Outlook 2016 to draw Using Outlook 1
O Outlook 365 - suddenly unable to send using Gmail POP3 Using Outlook 10
N Disable Auto Read Receipts sent after using Advanced Find Using Outlook 4
G Outlook 2016 sync contacts directly between phone and computer using outlook 2016 Using Outlook 0
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
O Save attachments using hotkey without changing attributes Outlook VBA and Custom Forms 1
J Add an Attachment Using an Array and Match first 17 Letters to Matching Template .oft to Send eMail Outlook VBA and Custom Forms 2
A Edit subject - and change conversationTopic - using VBA and redemption Outlook VBA and Custom Forms 2
A Using or not using apostrophes in search terms has this changed? Using Outlook 0
O Office 365 using POP3 on both laptop and desktop Using Outlook 0

Similar threads

Back
Top