يتم فرز عناصر التقويم المشفرة إلى البريد الإلكتروني عن طريق إنشاء تاريخ - تحتاج إلى الترتيب حسب موعد تاريخ

Question

الرمز الموجود أسفل البريد الإلكتروني بسعادة بريدا إلكترونيا مع Appoinments الأسبوعية ولكنه يسرد عناصر التقويم في البريد الإلكتروني حسب موعد إنشاء تاريخ بدلا من تاريخ الموعد الفعلي.هل هناك طريقة لسرد العناصر حسب تاريخ المواعيد؟ شكري متواضع لأي مساعدة أو اقتراحات. (لا أستطيع أن أكون ائتمان لهذا الرمز لأنني قمت بلصق القطع الموجودة على الشبكة. أنا أكثر دراية بالتفوق والوصول إلى VBA من Outlook. مرة أخرى شكري.) جون giveacodicetagpre.

Answer 1

I have not reviewed your existing code although I did spot:

1. If you created a list of my appointments and omitted my all day meetings, I would be seriously displeased.
2. AddToReportIfNotBlank is not a function because it does not return a value.

With my solution you do not add appointments to Report as they are discovered. Instead they are added to an array of structures. Once all relevant appointments have been found, an array of indices into the array of structures is created and sorted by appointment date. Report is then built from the array of structures in index sequence. I hope that makes sense. Extra detail in the code.

My solution requires a structure. The type definition must be placed before any subroutines or functions.

Type typAppointment
  Start As Date
  AllDay As Boolean
  End As Date
  Subject As String
  Location As String
End Type

I need these variables in addition to yours:

  Dim AppointmentDtl() As typAppointment
  Dim InxADCrnt As Long
  Dim InxADCrntMax As Long
  Dim InxAppointmentSorted() As Long
  Dim InxSrtCrnt1 As Long
  Dim InxSrtCrnt2 As Long
  Dim Stg as String

This code prepares the array of structures for use. Place before the loop that looks for appointments:

  ReDim AppointmentDtl(1 To 100)
  ' * I avoid having too many ReDim Preserves because they
  '   involve creating a copy of the original array.
  ' * 100 appointments should be enough but the array will
  '   be resized if necessary.
  InxADCrntMax = 0      ' The current last used entry in AppointmentDtl

Delete your code:

        Call AddToReportIfNotBlank(Report, "Subject", currentAppointment.Subject)
        Call AddToReportIfNotBlank(Report, "Start", currentAppointment.Start)
        Call AddToReportIfNotBlank(Report, "End", currentAppointment.End)
        Call AddToReportIfNotBlank(Report, "Location", currentAppointment.Location)
        Report = Report & "-----------------------------------------------------"
        Report = Report & vbCrLf & vbCrLf

and replace with the following which stores the detail of the selected appointments in the structure. This code handles all day meetings as well as part day meetings:

        InxADCrntMax = InxADCrntMax + 1
        If InxADCrntMax > UBound(AppointmentDtl) Then
          ' Have filled array.  Add another 100 entries
          ReDim Preserve AppointmentDtl(1 To 100 + UBound(AppointmentDtl))
        End If
        AppointmentDtl(InxADCrntMax).Start = .Start
        If .AllDayEvent Then
          AppointmentDtl(InxADCrntMax).AllDay = True
        Else
          AppointmentDtl(InxADCrntMax).AllDay = False
          AppointmentDtl(InxADCrntMax).End = .End
        End If
        AppointmentDtl(InxADCrntMax).Subject = .Subject
        AppointmentDtl(InxADCrntMax).Location = .Location
      End If

Above Call CreateReportAsEmail("List of Appointments", Report) insert:

  ' Initialise index array as 1, 2, 3, 4, ...
  ReDim InxAppointmentSorted(1 To InxADCrntMax)
  For InxSrtCrnt1 = 1 To InxADCrntMax
    InxAppointmentSorted(InxSrtCrnt1) = InxSrtCrnt1
  Next

  ' Sort index array by AppointmentDtl(xxx).Start.
  ' This is not an efficient sort but it should be sufficient for your purposes.
  ' If not, I have a Shell Sort written in VBA although a Quick Sort
  ' is considered the best.
  InxADCrnt = 1
  Do While InxADCrnt < InxADCrntMax
    InxSrtCrnt1 = InxAppointmentSorted(InxADCrnt)
    InxSrtCrnt2 = InxAppointmentSorted(InxADCrnt + 1)
    If AppointmentDtl(InxSrtCrnt1).Start > AppointmentDtl(InxSrtCrnt2).Start Then
      InxAppointmentSorted(InxADCrnt) = InxSrtCrnt2
      InxAppointmentSorted(InxADCrnt + 1) = InxSrtCrnt1
      If InxADCrnt > 1 Then
        InxADCrnt = InxADCrnt - 1
      Else
        InxADCrnt = InxADCrnt + 1
      End If
    Else
      InxADCrnt = InxADCrnt + 1
    End If
  Loop

  ' InxAppointmentSorted() is now: 5, 20, 2, ... where appointment 5 is
  ' the earliest, appointment 20 the next and so on

  ' Process appointments in Start order
  For InxSrtCrnt1 = 1 To InxADCrntMax
    InxADCrnt = InxAppointmentSorted(InxSrtCrnt1)
    With AppointmentDtl(InxADCrnt)
      ' I have tested all other code on my calendar.  This code is untested.
      ' I have included all day meetings but you could easily restore the
      ' original approach.
      Call AddToReportIfNotBlank(Report, "Subject", .Subject)
      If .AllDay Then
        Stg = "All day " & Format(.Start, "dddd d mmm")
      Else
        ' Date formatted as "Friday 27 Jan". Use "dddd mmmm, d" if you
        ' prefer "Friday January, 27".  That is: "d" gives day of month
        ' with leading zero omitted. "dddd" gives full day of week. "mmm"
        ' gives three letter month.  "mmmm" gives full month.  "yy", if
        ' required, give two day year. "yyyy" gives four day year. Include
        ' spaces and punctuation as desired. 
        Stg = Format(.Start, "dddd d mmm") & _
              Format(.Start, " hh:mm") & " to " & _
              Format(.End, "hh:mm")
      End If
      Call AddToReportIfNotBlank(Report, "When", Stg)
      Call AddToReportIfNotBlank(Report, "Location", .Location)
      Report = Report & "-----------------------------------------------------"
      Report = Report & vbCrLf & vbCrLf
    End With
  Next

I hope I have included enough comments so all this makes sense. Do come back with questions is necessary.