Как создать запись iCalendar, которая работает в Outlook, Android и iOS

Question

Задача состояла в том, чтобы регулярно отправлять кучу писем с встречами из Excel.Для этого я включил макросы, которые генерировали файлы iCalendar, прикрепил их к электронному письму и отправил их автоматически.

Проблема:

Электронная часть была самой простой.Но не запись в iCalendar!Если вы просто сгенерируете запись с начальным и конечным временем, она будет импортирована Outlook и отображает правильное время в вашем календаре.Но если вы попытаетесь импортировать эту запись в свой телефон Android или iPhone, вы получите неправильное время или даже сообщения об ошибках.

Самая большая проблема заключается в том, что Android воспринимает все как кодировку UTC.Хорошо, тогда создайте запись iCalendar в UTC, и проблема решена.Но это звучит легче, чем сделано.Особенно, если вы живете в Европе и вам приходится иметь дело с переходом на летнее время и отправкой электронных писем с записями iCalendar, которые переступают через начальную или конечную дату сохранения.

Решение:

Чтобы вычислить правильное преобразование из местного времени в UTC, можно использовать два вызова функций в модуле Kernel32 Windows, чтобы выполнить всю математику:

GetTimeZoneInformation и TzSpecificLocalTimeToSystemTime

Комупроверьте правильность своей записи в iCalendar, есть веб-сайт, предлагающий онлайн-проверку.Я использовал это: https://icalendar.org/validator.html. Если этот валидатор больше не жалуется, вы в порядке.Запись iCalendar, сгенерированная из приведенного ниже кода, теперь принимается всеми приложениями и везде выдает правильное время.

Запустите подпрограмму TestIt, чтобы посмотреть, как она работает.

Текущий код генерирует толькоэлектронное письмо, пользователь должен нажать кнопку отправки вручную.Но если вы переместите комментарий с '.Send на .Display, электронное письмо будет отправлено без дальнейшего уведомления.Вы найдете его в папке отправки.

Снимок экрана с составленного письма

Вот код:

Option Explicit


' For time & date conversion from CET/CEST to UTC see
' https://docs.microsoft.com/en-us/windows/desktop/api/timezoneapi/nf-timezoneapi-gettimezoneinformation
' and
' https://docs.microsoft.com/en-us/windows/desktop/api/timezoneapi/nf-timezoneapi-tzspecificlocaltimetosystemtime

Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
  Bias As Long
  StandardName(0 To 31) As Integer
  StandardDate As SYSTEMTIME
  StandardBias As Long
  DaylightName(0 To 31) As Integer
  DaylightDate As SYSTEMTIME
  DaylightBias As Long
End Type

Private Declare Function GetTimeZoneInformation Lib "Kernel32" _
  (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function TzSpecificLocalTimeToSystemTime Lib "Kernel32" _
  (lpTimeZoneInformation As TIME_ZONE_INFORMATION, _
   lpLocalTime As SYSTEMTIME, lpUniversalTime As SYSTEMTIME) As Integer

Public objFSO As New FileSystemObject


Private Sub TestIt()
  Call SendTextEmailWith_iCalendar("joe.sixpack@example.com", "2019-02-28 14:00", "2019-02-28 14:30")
End Sub


' This subroutine creates / sends a plain text formatted email with an iCalendar entry as attachment.
Private Sub SendTextEmailWith_iCalendar( _
  EmailAddress As String, _
  EventStart As Date, _
  EventEnd As Date _
)
  Dim objOutlook As Object
  Dim objMail As Object
  Dim TempIcsFilename As String

  ' Put date, start and end time into filename.
  TempIcsFilename = Environ$("temp") & "\iCalendar Entry " & Format(EventStart, "YYYYMMDD") & " " & _
                    Format(EventStart, "hhmm") & "-" & Format(EventEnd, "hhmm") & ".ics"
  Call Create_iCalendar_File(TempIcsFilename, EventStart, EventEnd, "This is the summary", _
                              "This is the location", 5)

  Set objOutlook = CreateObject("Outlook.Application")
  Set objMail = objOutlook.CreateItem(0)

  With objMail
   .To = EmailAddress
   .Subject = "Your appointment at " & Format(EventStart, "YYYY-MM-DD"" at ""hh:mm"" hours""")
   .Body = "This is an automated email with an iCalendar entry for your next appointment."
   .Attachments.Add TempIcsFilename
   .Display ' Displays only the composed email. The user has to send it.
   '.Send   ' Sends the composed email without further query.
  End With

  Kill TempIcsFilename
  Set objMail = Nothing
  Set objOutlook = Nothing
End Sub


' Creates an iCalendar file of the given arguments with UTC coded start-date and end-date.
' This will then be accepted by Android and iOS calendar apps as well as MS Outlook with the correct
' time local time.
Private Sub Create_iCalendar_File( _
  Filename As String, _
  EventStart As Date, _
  EventEnd As Date, _
  Summary As String, _
  Optional Location As String = "", _
  Optional Reminder As Integer = 15 _
)
  Dim fso As Object
  Dim TimeZoneInfo As TIME_ZONE_INFORMATION
  Dim UTC As SYSTEMTIME
  Dim LocalTime As SYSTEMTIME

  ' Get the time zone info of the system settings.
  Call GetTimeZoneInformation(TimeZoneInfo)

  ' Create an iCalendar file for the specified time window. Some of the properties seem superfluous
  ' or redundant at first glance. Ommitting them leads to warnings / errors in some calendar tools.
  ' Use iCalendar Validator from https://icalendar.org/validator.html to check your entry.
  Set fso = objFSO.CreateTextFile(Filename, Overwrite:=True)
  With fso
    .WriteLine ("BEGIN:VCALENDAR")
    .WriteLine ("PRODID:-//<Replace this with your program/company info>//EN")
    .WriteLine ("VERSION:2.0")
    .WriteLine ("BEGIN:VEVENT")
    .WriteLine ("UID:<Make this unique for your program>-" & Format(Now(), "YYYYMMDD""-""hhmmss"))
    ' Timezone doesn't matter for the time stamp.
    .WriteLine ("DTSTAMP:" & Format(Now(), "YYYYMMDD""T""hhmmss"))

    LocalTime = DateToSystemTime(EventStart)
    Call TzSpecificLocalTimeToSystemTime(TimeZoneInfo, LocalTime, UTC)
    .WriteLine ("DTSTART:" & SystemTimeToDTString(UTC))

    LocalTime = DateToSystemTime(EventEnd)
    Call TzSpecificLocalTimeToSystemTime(TimeZoneInfo, LocalTime, UTC)
    .WriteLine ("DTEND:" & SystemTimeToDTString(UTC))

    .WriteLine ("LOCATION:" & Location)
    .WriteLine ("PRIORITY:5") ' Normal priority
    .WriteLine ("SEQUENCE:0")
    .WriteLine ("SUMMARY:" & Summary)
    .WriteLine ("BEGIN:VALARM")
    .WriteLine ("TRIGGER:-PT" & Reminder & "M")
    .WriteLine ("ACTION:DISPLAY")
    .WriteLine ("DESCRIPTION:Reminder")
    .WriteLine ("END:VALARM")
    .WriteLine ("END:VEVENT")
    .WriteLine ("END:VCALENDAR")
    .Close
  End With

  Set fso = Nothing
End Sub


' Convert Date into SYSTEMTIME
Private Function DateToSystemTime(TimeStamp As Date) As SYSTEMTIME
  With DateToSystemTime
    .wYear = Year(TimeStamp)
    .wMonth = Month(TimeStamp)
    .wDay = Day(TimeStamp)
    .wHour = Hour(TimeStamp)
    .wMinute = Minute(TimeStamp)
    .wSecond = Second(TimeStamp)
    .wMilliseconds = 0
  End With
End Function


' Convert SYSTEMTIME into a DTSTART/DTEND string
Private Function SystemTimeToDTString(TimeStamp As SYSTEMTIME) As String
  With TimeStamp
    SystemTimeToDTString = Format(DateSerial(.wYear, .wMonth, .wDay) + _
                                  TimeSerial(.wHour, .wMinute, .wSecond), _
                                  "YYYYMMDD""T""hhmmss""Z""")
  End With
End Function