LoginSignup
2
1

More than 3 years have passed since last update.

イルクーツクより愛をこめて Outlook Excel VBA OUTLOOK/Google Calender共用のicsファイルを作成する CSV field LIst

Last updated at Posted at 2019-09-18

Flow

  1. Excelに入力用のシートを作成する
  2. Excelからicsファイルを作る。複数の予定も一括して入力できる。
  3. ダブルクリックして読み込む。新しいフォルダにまとめて予定が設定される。
  4. 新しいフォルダに入れたくない場合はOutlookを開き、取り込みたいカレンダーを表示させてicsファイルをドラッグアンドドロップする。
  5. このファイルを https://support.google.com/calendar/answer/37118?hl=ja Googleのヘルプを参考にして読み込むと新しい予定が読み込まれる。ただし、デフォルトの予定表に取り込まれ、読み込む一連の予定が単独の独立した予定表として読み込まれることはない。

icsファイルの構造で注意すべきこと

icalender形式のファイルの拡張子はicsです。

個々の予定はイベントと表現される

通常、予定といわれれば、
4/10 06:00 妻とパーティに行く
4/17 06:00 妻とオペラに行く
このようなものをイメージするでしょう。
しかしこのような個々の「予定」はVEVENTというイベントになります。
この個々の予定をまとめたものがicalenderとなります。
ここが読んでいるとき非常に混乱する一つの原因です。
またOUTLOOKでは予定表の題名(件名)はSubject、メモ(本文)はBodyですが、ics では Summery,Descriptionです。
個々の予定をまとめたものをここではつとめて予定表と呼んでいますが、引用した記事はその記事内での呼び方になっています。たとえばグループスケジュール。予定表リスト、購読する予定表などという表現はすべてこの記事では「予定表」です。
VBAに詳しい人なら、appintomentietems(こんなコレクションはありませんが、無理にVBAで当てはめるとコレクションはアイテムの複数形で示されることが多いので、こうした表現になるでしょう)アポイントメントアイテムのコレクション、予定オブジェクトコレクションなどと呼ぶかもしれません。

なおicsファイルが予定表であるのは

X-WR-CALNAME:追加された予定
X-WR-CALDESC:icsファイルから追加された予定です

この2行がある場合です。
もしこの2行がなくて、イベントが一つの場合には単純な予定オブジェクト、Outlookで言えば、calendar object つまり、appointmentitem ということになります。

icalenderの項目はRFCで決まっている

icalender形式はVCalender形式の後継(ほぼ互換)
最初に策定されたのがRFC2445
http://www.faqs.org/rfcs/rfc2445.html
そしてRFC5445に置き換えられている。またこのあとも更新されている。
https://tools.ietf.org/html/rfc5545
https://stackoverflow.com/questions/3615111/how-is-rfc-5545-different-from-rfc-2445
定期的な予定の除外がリスト形式のみになったのが痛いという人もいるが、ほとんど同じ。またOUTLOOKでは除外が効かないため、この変更は影響しない。
MicrosoftはExchangeSeverのところでダウンロードできます。140ページ以上あります。
https://docs.microsoft.com/en-us/openspecs/exchange_server_protocols/ms-oxcical/a685a040-5b69-4c84-b084-795113fb4012
MS公式のicsの例。X-MS-OLK-、X-MS-CDO-もここにあります。
https://docs.microsoft.com/en-us/openspecs/exchange_server_protocols/ms-oxcical/3babc5c2-5d1b-4366-b8c1-e0b49fe5cc26

icsファイルから読み込むメリット

  1. icsファイルは複数の予定(イベント)をまとめて(予定表として)読み込める
  2. 現に使用されている地球上のすべての電子媒体で使用することができる。
  3. OUTLOOKではさらにそれを一つのスケジュールフォルダにまとめてインポートする
  4. この性質を使うとOUTLOOKではプロジェクトごとにスケジュールを作成することができる
  5. 不要になったらプロジェクトごと削除できる
  6. プロジェクトというかicsファイルを読み込むとき、Outlookは一つのフォルダを作成して予定をインポートする

デメリット

  1. 現在のSub makeicsfilejp()は日本時間のみのタイムゾーンとしている。複数のタイムゾーンに対応していない。できないことはないが複雑。
  2. Excelで参照設定を使うので、参照設定がわからない人には使えない
  3. GoogleとMicrosoft OUTLOOKにどの程度整合性があるのかが不明

まずシートを作ります

Sub MakeSheetForm2()
 Version 2
' Excel
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim iRow As Long, iCol As Long, LastRow As Long, LastCol As Long, R As Range, URng As Range, Cnt As Long
Dim arRow2, arRow3
Dim DT As Date
Dim NotMemoThisisTrueCalledAsComment As Comment, shp As Shape, shpRng As ShapeRange
DT = Now
If MsgBox("いったん消去します Now Start Clear all OK?", vbOKCancel) = vbOK Then
ws.UsedRange.Clear
arRow2 = Split("Summary,StartDateTime,EndDateTime,Location,importance(Normal;High;Low),AlldayEvent(False;TRUE),FreeBusyStatus(TENTATIVE;BUSY;Free),Alarm(0 is none:UNIT=minutes),Description(改行は \n),URL,DD Format Geotag(37.5739497;-85.7399606),Categories(Delimiter is comma),Contact,Priority(5)", ",")
arRow3 = Split("Birthday," & Format(DT + 1, "yyyy/mm/dd 10:00:00") & "," & Format(DT + 1, "yyyy/mm/dd 10:30:00") & ",Home,Nomal,FALSE,TENTATIVE,15,This is \n test item,www.google.co.jp,28.0000;135.0000,Schedule,me,5", ",")

ws.Range("A1").Value = "Project Name:": ws.Range("B1").Value = "icsfilename"
iCol = 1
For Cnt = LBound(arRow2) To UBound(arRow2)
ws.Cells(2, Cnt + 1).Value = arRow2(Cnt)
ws.Cells(3, Cnt + 1).Value = arRow3(Cnt)
Next
End If
ws.Range("E3").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Normal,High,Low"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeOff
        .ShowInput = True
        .ShowError = False
End With
ws.Range("G3").Select
With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="TENTATIVE,Busy,Free"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeOff
        .ShowInput = True
        .ShowError = False
End With
ws.Range("A1").Select

    Columns("A:A").EntireColumn.AutoFit
    Columns("A:A").ColumnWidth = 14.25
    Range("B1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Set NotMemoThisisTrueCalledAsComment = Range("B1").AddComment
    Set shp = NotMemoThisisTrueCalledAsComment.Shape
    NotMemoThisisTrueCalledAsComment.Visible = False
    NotMemoThisisTrueCalledAsComment.Text Text:= _
        "Input Schedule name(will become filename)" & Chr(10) & "予定表の名前を入力してください。(例;野球部の強化合宿の予定表)" & Chr(10) & "ファイル名になります。"

    shp.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
    shp.ScaleHeight 1.71, msoFalse, msoScaleFromTopLeft
    Range("D8").Select
End Sub

入力します(注意事項あり)

image.png

B1のプロジェクト名をファイル名として使うので必ず入力してください。

まずB1のオデッサ作戦としてるセルに必ずプロジェクト名を入れてください。それでファイルができます。
また、同名のicsファイルがあれば削除しますのでご注意ください。

プロジェクト名は255文字以内で改行を含むことができません

なので25文字程度にしてください。あとはフォルダ名で使ったりしますので。

プロジェクト名に絵文字や機種依存文字は使用しないでください

できるだけANSIもしくはShiftJisの範囲を推奨します。ファイル名に使用するためです。

秘密の予定は設定しないでください

今回のマクロはデフォルトで「Public」設定です。したがって秘密の予定は設定しないようにしてください。
しかしオデッサ作戦とか漏らしたらまずいかな。

長さ0時間0分の予定はGoogleがエラーを起こします

このため、B列の開始日時とC列の終了日時は同じ値にしないでください。Outlook はよいのですが、Google Calenderがエラーを起こします。

時間まで設定してください

なお、今回のVBAは日本時間が前提なので、日時も日本時間になります。
日付だけでいいときは午前10時と午前11時に設定してください。これはOutlookのViewが8時から17時までを表示するためです。
また、何らかの原因で時差が生じても、午前10時からどれくらいずれているかでヒントが得られます。
もちろん日付だけでも仕様上は問題がないのですが、
またAlldayEventが入るとC列は無視されます。

仮の予定を推奨します

自動的に入力する場合はFreeAndBusyはTENTATIVE(仮の予定)がいいと思います。

Priorityは意味はないが5を標準とする、0が優先度なし

OUTLOOKにおいてPriorityに意味はありません。しいていえば0が最弱ですが、OUTLOOKはこの設定が効きません。あとからCSVのリストを書きますが、一番最後の優先度はImportanceであってPriorityではありません。

マクロ

参照設定

ADODB Streme
Scripting Filesystemobject
Vbscript.Regular Expression 5.5

ドライブ名の決定

動かす前に出力ドライブフォルダ名を変えてください
次のD:\testfolder\ が実在するとして、
Const OutputDrive = "D:\"
Const OutputFolder = "testfolder\"

Sub MakeicsFileJP3()
' Language : Japanese 日本語
' ics file Output Folder
Const OutputDrive = "h:\"
Const OutputFolder = "dbfolder\"
' Language : Japanese 日本語
Const icsLang = ";Language=""ja"":"
'Time Zone
Const icsTz = ";TZID=""Asia/Tokyo"":"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim iRow As Long, iCol As Long, LastRow As Long, LastCol As Long, R As Range, URng As Range
Dim DTSTART As Date, DtEnd As Date
Dim blAlldayEvent As Boolean
Dim sr As ADODB.Stream
Dim oFile As File, oFolder As Folder
Dim MC As MatchCollection, M As Match, sMs As SubMatches, iM As Long
Dim buf As String
Dim FSO As New Scripting.FileSystemObject
Dim icsJapanHeader As String
Dim strRemind As String
icsJapanHeader = _
"BEGIN:VCALENDAR" & vbCrLf & _
"PRODID:-//Microsoft Corporation//Outlook 19.0 MIMEDIR//EN" & vbCrLf & _
"CALSCALE: GREGORIAN" & vbCrLf & _
"x-WR-CALNAME:" & ws.Range("B1").Value & vbCrLf & _
"x-WR-CALDESC:" & "Added ics file :" & ws.Range("B1").Value & ".ics" & vbCrLf & _
"X-WR-TIMEZONE:Asia/Tokyo" & vbCrLf & _
"VERSION:2.0" & vbCrLf & _
"METHOD:Publish" & vbCrLf & _
"BEGIN:VTIMEZONE" & vbCrLf & _
"TZID:Asia/Tokyo" & vbCrLf & _
"BEGIN:STANDARD" & vbCrLf & _
"DTSTART:16010101T000000" & vbCrLf & _
"TZOFFSETFROM:+0900" & vbCrLf & _
"TZOFFSETTO:+0900" & vbCrLf & _
"TZNAME:JST" & vbCrLf & _
"End:STANDARD" & vbCrLf & _
"End:VTIMEZONE"
Const unremind = "END:VEVENT"
Set sr = New ADODB.Stream
With sr
.Mode = adModeReadWrite
.Type = adTypeText
.LineSeparator = adCRLF
.Charset = "utf-8"
.Open
sr.WriteText icsJapanHeader, adWriteLine
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For iRow = 3 To LastRow
.WriteText "BEGIN:VEVENT", adWriteLine
' Organizer と Atendeeは会議の予定になるので使用しないほうが良い。使うときは両方設置する。ProgIDとも関係してくる
'.WriteText "ORGANIZER:MAILTO:.mailadderss@example", adWriteLine
'.WriteText "ATENDEE:MAILTO:.mailadderss@example", adWriteLine
'.WriteText "CLASS:PUBLIC" & vbCrLf & "DESCRIPTION:" & ws.Range("A" & iRow).Value, adWriteLine
DTSTART = ws.Range("B" & iRow).Value
buf = Format(DTSTART, "yyyymmdd""T""hhMMss")
'.WriteText "Created:"":" & buf, adWriteLine 'Outlook importing error
'.WriteText "DTSTAMP:"":" & buf, adWriteLine 'Outlook importing error
.WriteText "DTSTART" & icsTz & buf, adWriteLine
DtEnd = ws.Range("C" & iRow).Value
'buf = Format(DtEnd - CDate("09:00:00"), "yyyymmdd""T""hhMMss""z""")
buf = Format(DtEnd, "yyyymmdd""T""hhMMss") '最後にUTCを表す末尾の「Z」を消せばTZIDで設定した地域のタイムゾーンで読み込まれます。
.WriteText "DTEnd" & icsTz & buf, adWriteLine
If ws.Range("M" & iRow) <> "" Then
.WriteText "CONTACT:" & ws.Range("M" & iRow), adWriteLine
End If
.WriteText "X-MICROSOFT-CDO-BUSYSTATUS:" & ws.Range("H" & iRow), adWriteLine
Select Case LCase(ws.Range("G" & iRow).Value)
Case Is = "busy"
.WriteText "TRANSP:OPAQUE", adWriteLine
Case Else
.WriteText "TRANSP:TRANSPARENT", adWriteLine
End Select
' Importance 重要度(Outlookは3段階)
Select Case LCase(ws.Range("E" & iRow).Value)
Case Is = "normal"
.WriteText "X-MICROSOFT-CDO-IMPORTANCE:1", adWriteLine
Case Is = "high"
.WriteText "X-MICROSOFT-CDO-IMPORTANCE:2", adWriteLine
Case Is = "low"
.WriteText "X-MICROSOFT-CDO-IMPORTANCE:0", adWriteLine
End Select

' 終日のイベントか
.WriteText "X-MICROSOFT-CDO-ALLDAYEVENT:" & ws.Range("F" & iRow), adWriteLine
' Subject 件名
.WriteText "SUMMARY" & icsLang & ws.Range("A" & iRow), adWriteLine 'VBAで設定するときはSubject
buf = ""
'.WriteText "DEScription;LANGUAGE=ja:" & ws.Range("A" & iRow), adWriteLine 'VBAで設定するときはBody
If ws.Range("K" & iRow) <> "" Then
buf = "DESCRIPTION" & icsLang & ws.Range("I" & iRow) & " \n " & "https://www.google.com/maps/@?api=1&map_action=map&center=" & Replace(ws.Range("K" & iRow).Value, ";", ",", 1, 1, vbBinaryCompare)
.WriteText "GEO:" & Replace(ws.Range("K" & iRow).Value, ";", ",", 1, 1, vbBinaryCompare)
Else
buf = "DESCRIPTION" & icsLang & ws.Range("I" & iRow) & vbCrLf
End If
If ws.Range("J" & iRow) <> "" Then
.WriteText "URL;VALUE=URI:" & ws.Range("J" & iRow), adWriteLine
buf = buf & " \n " & vbCrLf & vbTab & "Outlook は URLが無視されるため、詳細に書きだします。URLは以下の通りです。 \n" & vbCrLf & vbTab & ws.Range("J" & iRow)
.WriteText buf, adWriteLine
Else
.WriteText buf, adWriteLine
End If
' Category コンマ区切りのままでもOutlookは複数のカテゴリーとして読み込むためセミコロン区切りは誤った入力として修正。間違うと余計なカテゴリーが増えてしまうので、表記は正確に。全角、半角、大文字、小文字注意。
If ws.Range("L" & iRow) <> "" Then
.WriteText "Categories:" & Replace(ws.Range("L" & iRow), ";", ",", 1, -1, vbTextCompare), adWriteLine
End If

' Priority 通常は5 0は優先度なし。しかし全く表示されないので、空白なら5、0以上の整数なら反映
If CLng(ws.Range("N" & iRow)) >= 0 Then
.WriteText "Priority:" & ws.Range("N" & iRow), adWriteLine
Else
.WriteText "Priority:5"
End If
.WriteText "UID:" & Format(Now, "yyyyMMddThhmmss"), adWriteLine
'sr.WriteText "X-MICROSOFT-DISALLOW-COUNTER:FALSE" & vbCrLf & _
"X-MS-OLK-AUTOFILLLOCATION:FALSE", adWriteLine
If ws.Range("H" & iRow) <> 0 Then
If LCase(ws.Range("E" & iRow)) Like "high" Then
iM = CLng(ws.Range("H" & iRow) / 3)
strRemind = "BEGIN:VALARM" & vbCrLf & _
"TRIGGER:-PT" & ws.Range("H" & iRow) & "M" & vbCrLf & _
"ACTION:Display" & vbCrLf & _
"REPEAT:" & iM & vbCrLf & _
"DURATION:PT" & iM & "M" & vbCrLf & _
"DESCRIPTION:Reminder" & vbCrLf & _
"End:VALARM" & vbCrLf & _
"END:VEVENT"
Else
strRemind = "BEGIN:VALARM" & vbCrLf & _
"TRIGGER:-PT" & ws.Range("H" & iRow) & "M" & vbCrLf & _
"ACTION:Display" & vbCrLf & _
"DESCRIPTION:Reminder" & vbCrLf & _
"End:VALARM" & vbCrLf & _
"END:VEVENT"
End If
.WriteText strRemind, adWriteLine
Else
.WriteText unremind, adWriteLine
End If
Next
.WriteText "END:VCALENDAR"
If FSO.FolderExists(OutputDrive & OutputFolder) Then
Set oFolder = FSO.GetFolder(OutputDrive & OutputFolder)
If FSO.FileExists(oFolder.Path & "\" & StrConv(ws.Range("B1").Value, vbNarrow) & ".ics") Then FSO.DeleteFile oFolder.Path & "\" & StrConv(ws.Range("B1").Value, vbNarrow) & ".ics"
If Len(oFolder.Path & "\" & StrConv(ws.Range("B1").Value & ".ics", vbNarrow) & ".ics") <= 255 Then
.SaveToFile oFolder.Path & "\" & StrConv(ws.Range("B1").Value, vbNarrow) & ".ics", adSaveCreateNotExist
End If
End If
End With
End Sub

ポイント

UTF-8であること、改行コードがCRLFであること

ADODBを使うのはそのためです。これは仕様です。
しかし、メモ帳で上書きしていると、知らない間にUTF-16LEになったりします。
このコードになると、Googleでは読み込まれなくなります。Outlookはしぶとく読みます。
通常VBAでADODBを使用するとき、改行コードは通常vbCrLfを使うと思いますので設定で問題がありません。

Descriptionで改行を使うには

詳細の中の改行コードは \nです。Excelでは円マークnです。NewLineという意味です。
ただしこのように複雑になるとUIDがないとエラーになります

Icalenderの中での折り返し

https://www.kanzaki.com/docs/sw/rdf-calendar.html#ref-tzlink
行の長さと折り返し
プロパティ:値のペアを1行に記述します。長い行(目安として75バイト以上)は改行して、次の行の先頭にスペースもしくはTABを1文字入れることで、行を連続させられます。

拡張子はics

icalとかになりそうですが、icsです。しかしsってなんですかね。。。

UIDはわからないけど空でいいから項目を作らないと複数の予定が読み込めない

UIDがないとOUTLOOKは予定表を読み込まないというのはおそらくOUTLOOK2019では変えています。
なくてもエラーを吐きながら読み込みます。
また、Descriptionが比較的単純だと、空白でも通ります。
いろいろな例を見ると、適当なUIDであれば現在の日付をもっていくといいようです。
.WriteText "UID:" & Format(Now, "yyyyMMddThhmmss"), adWriteLine

"PRODID:-//Microsoft Corporation//Outlook 19.0 MIMEDIR//JP"は現在適当

2019日本版っぽい名前にしていますが、それだけです。ただし空白にしないほうがいいようです。
しかし、ProgIDは会議の予定でない限り、多少変でも大丈夫です。必須な割に書き方がよくわからない。いきなりの敷居ですが、適当にOUTLOOKとか使うといいです。
https://www.kanzaki.com/docs/sw/rdf-calendar.html
https://www.kanzaki.com/docs/html/doctype.html#fpi
によるとフォーマル公開識別子FPIもしくはURNで書くことが一般的とされています。それによるとJPにしても日本語としてとらえてくれないようです。
ただし、OrganizerとAtendeeを設定したときに重要になります。メールアドレスとサーバーの関係が正しい必要があるようです。
ロクナナのicsファイルはそれを利用しています。
グループのスケジュール・カレンダーをもつコンポーネントはOrganizerが必須というより、会議やグループのスケジュールではProgID、Orginizer、Atendeeを定義する必要がでてくるといえるようです。しかしicsファイルで予定表を共有しようというときにはむしろ不要です。
なぜなら、これを定義するとOutlookは会議だと思い込みExchangeがどうのこうの言い出して変な文字列をくっつけるので大変うざいです。

むしろ"METHOD:Publish"が重要

前記項目で紹介しているサイトでは、ここがないとOUTLOOKは予定を読み込まないとしています。
確かに公開方法がわからないとインポートしても表示してよいのかわかりません。

Zの有無で時間が変わる

buf = Format(DtEnd - CDate("09:00:00"), "yyyymmdd""T""hhMMss""z""")
このように末尾にzをつけるとUTCのZULU、GMTとの時差0となります。このためJSTにするには9時間引かないといけません。
個人的にはタイムゾーンが複数の時はUTCベースで打つほうがいいのかもしれません。

TimeZoneはVTIMEZONEコンポーネントでTZIDを定義し、その名称をX-WR-TIMEZONEとあわせる

これがコツです。このあとのDTStart,DTEndでTZIDを使用することで、エラーがなくなります。

予定表のなしあり

これは仮の予定を標準としていますが、BusyやFreeが選択できます。
この時、GoogleはTransParentなので、その設定がファイルに自動的に書き込まれます。
仮の予定の時はなにもしていません。

Valarmコンポーネントは現在太平洋標準時

-pt15Mという形でサンプルが見つかっていますが、これは太平洋時間(Pasiffic Time)でマイナス15分です。
PTとJSTは時差がないため、日本だけを考えた場合は使用して問題がありません。
このため、上記マクロは現在この定義を利用してAlarm - Reminderを設定しています。

イルクーツクを含む参考文献

http://www.asahi-net.or.jp/~CI5M-NMR/iCal/ref.html
https://support.microsoft.com/ja-jp/help/287625/how-to-use-vcalendar-in-outlook
https://support.microsoft.com/en-us/help/2269506/developer-support-limitations-for-public-protocols
https://docs.microsoft.com/en-us/openspecs/exchange_server_protocols/ms-oxicsvcard/bf4ebd4e-d240-44f3-bf8c-eedf4f0b09e3?redirectedfrom=MSDN
はじめての iCalendar でスケジュールを作成する方法

BEGIN:VCALENDAR
METHOD:PUBLISH
VERSION:2.0
PRODID:[作成したアプリケーション?]
CALSCALE:GREGORIAN
X-WR-CALNAME:[このスケジュールリストの名前、ファイル名でなくてよい]
X-WR-CALDESC:[このスケジュールリストの詳細、ファイル名でなくてよい]
X-WR-TIMEZONE:Asia/Tokyo
BEGIN:VTIMEZONE
TZID:Japan
BEGIN:STANDARD
DTSTART:19390101T000000
TZOFFSETFROM:+0900
TZOFFSETTO:+0900
TZNAME:JST
END:STANDARD
END:VTIMEZONE
END:VCALENDAR

X-WR-CALNAME:[このスケジュールリストの名前、ファイル名でなくてよい]
X-WR-CALDESC:[このスケジュールリストの詳細、ファイル名でなくてよい]
ここはAppleがそうだというだけで、一般的にここがファイル名ということはないと思います。このようにicsファイルはその項目を各ソフトで勝手に解釈している点があるようです。どうもここは購読しているカレンダーのタイトルと詳細が本来の意味になるようです。

このX-WR-TIMEZONE:Asia/Tokyoは微妙でTokyo/AsiaだとGoogleは読めません。
他の例を見ても Tokyo/Japanにしたほうがいいと思います。

日時の部分は Ymd\THis で入力します。

ここがよくわからないのですが上記マクロはOUTLOOKの出力から、yyyy/mm/ddThh:mm:ssで出力しています。

http://www.asahi-net.or.jp/~CI5M-NMR/iCal/ref.html
とてもよく調べてありますが、Outlook2000の時と現在は違う点があります。

1ファイルには1つの VCALENDAR しか記述できない? 2つ以上記述しても、Outlook では最初のものしか認識しない。

たしかにVCALENDERは1つです。しかし、複数の予定、つまりイベントは設定できます。
STRT:VEVENT END:VEVENT の間に1つ記述することを繰り返すとよいのです。
もし、1つのファイルに複数のSTART:VCALENDER END:VCALENDERを繰り返すことができないから、複数の予定が定義できないといういみであれば誤りです。

DTSTAMP (RFC2445 4.8.7.2) オブジェクトの作成日時。
Outlook では必須。

これも違います。なくても動きます。あるとよみこむときにこれはいらないというエラーを出します。これは開始日時でよいです

Outlook がExportするCSVファイルの項目リスト

言語設定で項目は決まります
件名
開始日
開始時刻
終了日
終了時刻
終日イベント
アラーム オン/オフ
アラーム日付
アラーム時刻
会議の開催者
必須出席者
任意出席者
リソース
プライベート
経費情報
公開する時間帯の種類
支払い条件
場所
内容
秘密度
分類
優先度 ※これはics上はImportanceです

1つの.icsをGoogleカレンダー と iCal 両方に最適化
これはGoogleでエラーを起こすといっています。
あえて言うと、間違っています。なぜならDurationでExportすることは禁止されているからです。
しかしながらDurationがUTCベースだと
DURATION:PT7H0M0S
と書いてあることは価値があります。これはPT、パシフィックタイムで7時間という意味だからです。
Zuluと合わせているのでしょう。
このようにDurationを世界時で書くときはどこをベースにするのかが複雑です。
なので、やめたほうがいいと思います。
新しいカレンダーを作成する
THIDERBIRDといえどもGoogleCalenderを無視できない。それどころかアドオンまである。
「予定表の message.ics サポートされていません」という名前の添付ファイルを含むメッセージを受信します。
適用対象: Microsoft Office Outlook 2007Microsoft Outlook 2010
元の英語版の記事を表示する: 2643084
現象
Microsoft outlook では、ロータス ノーツのユーザーとは別のサード ・ パーティ製の電子メール クライアントから会議出席依頼が表示されます。メッセージには、次のファイルの名前を持つ添付ファイルが含まれています。
サポートされていない予定表 message.ics
さらに、添付ファイルを開くをダブルクリックすると、次のエラーが表示されます。
ファイル「サポートされていませんの予定表メッセージ .ics」は、有効なインターネット予定表ファイルではありません。
原因
元の .ics ファイルは、Outlook または Microsoft Exchange の会議の種類を変換できない場合は、「予定表の message.ics サポートされていません」の添付ファイルが作成されます。変換に失敗する場合または複数の次の条件に該当します。

会議には、ロータス ノーツなどのサード ・ パーティ製の電子メール クライアントに提供される定期的なパターンが含まれています。ただし、この定期的なパターンは Outlook ではサポートされません。
日付を月単位: 毎月n番目とn番目の日にします。Outlook には、月のn番目の日を 1 つのみサポートしています。
日単位で毎月: 毎月のn番目の曜日と週のn番目の日にします。Outlook では、任意の月の週のn番目の曜日を 1 つのみサポートします。
カスタムの定期的なアイテム: Outlook は、ロータス ノーツなどの一部のサード パーティ製の電子メール クライアントで使用できるカスタムの定期的なパターンをサポートしていません。
会議には、RDATE プロパティで定義されている定期的なパターンが含まれています。ただし、会議では、対応する RRULE プロパティは含まれません。この例では、Outlook がアイテムを開けません、RDATE プロパティがサポートされている定期的なパターンを指定するのではあって

回避策
この問題を回避するには、Outlook がサポートしている定期的なパターンを使用して会議を作成する会議の開催者があります。または、次の IBM web サイトがドミノ サーバー上で定期的なミーティングのオプションを管理する方法に関する情報を提供するロータス ノーツ クライアントは、ロータス ドミノ サーバーに接続する場合。
http://www-10.lotus.com/ldd/dominowiki.nsf/dx/Configuring_options_in_Domino_8.5_to_improve_interoperability_with_non-Notes_calendar_users
詳細情報
ロータス ノーツの定期的な会議を作成すると、この会議が定期的な「カスタム」オプションには、ロータス ノーツには、RDATE プロパティのみを含んだ .ics ファイルが生成されます。保存し、Outlook で受信した .ics ファイルの添付ファイルを開く場合は、RDATE プロパティが存在するを参照してくださいことができます。ただし、RRULE プロパティが存在しないことがわかります。Outlook と Exchange は、.ics 添付ファイルを処理し、定期的な会議を生成する RRULE プロパティによって異なります。RDATE と RRULE プロパティの詳細については、インターネット技術標準化委員会 (IETF) の web サイトで次のページを参照してください。
http://tools.ietf.org/html/rfc2445
この資料で説明するサードパーティ製のの製品は、マイクロソフトから独立した会社で製造されています。マイクロソフトは保証、黙示またはそれ以外の場合、パフォーマンスや信頼性これらの製品に関する負わない。他社テクニカル サポートのお問い合わせ窓口は、ユーザーの便宜のために提供されているものであり、この連絡先情報は予告なしに変更される場合があります。マイクロソフトは、掲載されている情報に対して、いかなる責任も負わないものとします。任意のこの資料に記載されている会社に連絡する方法の詳細については、次のマイクロソフト web サイトを参照してください。
http://support.microsoft.com/gp/vendors
最終更新日: 2019/05/20

Outlook への Google カレンダーのインポート
Googleカレンダーはicsファイルを作るので、それでもよい。おそらくだが、住所録や予定表は携帯電話、電子手帳(絶滅)、からスマホ、PCに至るまですべてicsファイルとvcfファイルに独自項目を追加しているというものであり、共通した項目をUSBケーブル、電子メール、赤外線、Bluetoothでやり取りしている。
Apple カレンダーに Google カレンダーの予定を表示する
世界中のカレンダーはGoogleとAndroidが握っていて、MicrosoftやAppleは格下の雑魚に過ぎない、完全に喧嘩を売っている見出し。

タイムゾーンを追加、削除、変更する
スケジュールのタイムゾーンがイルクーツクになる。outlook.comとoutlook2013でイルクーツクの標準時間がずれている

お世話になります。
1.スケジュールのタイムゾーンがイルクーツクになる
 Outlook.comの「カレンダー」およびoutlook2013の予定表のどちらも
タイムゾーンを「(UTC+09:00)大阪,札幌,東京」に設定しているのに
登録する予定がイルクーツクになってしまう。
原因は何ですか?また,一括で個々の予定のタイムゾーンの設定を直す方法を
教えてください。

2.outlook.comとoutlook2013でイルクーツクの標準時間がずれている
 上記の問題は今まではイルクーツクが日本と同じ「UTC+09:00」でしたので
表示上の問題で実害はなかったのですが,
今日,確認したところoutlook2013でイルクーツクの時間が「UTC+08:00」に
なっていました。(10/15付のアップデート後かもしれません)
 そのため,特にoutlook2013上で表示がおかしくなっており
おなじイルクーツクでも予定表上で+1時間の予定で表示されているものと
そうでないものが出ています。+1時間の予定で表示されているものは
outlook.comのカレンダー上だと通常通りで表示されています。
(例えば祝日カレンダーの大みそかがoutlook2013だと
12月31日午前1:00から1月1日午前1:00と表示されます)
なぜこのような現象が起こるのですか?

一括で個々の予定のタイムゾーンの設定をなおす方法を教えてほしいとのことですが、
Outlook.com のカレンダーではご希望されている操作が可能な機能はご用意しておりません。

参照スレッドを確認しましたが
「2.outlook.comとoutlook2013でイルクーツクの標準時間がずれている」
について参考になる情報はありませんでした。
時差の情報を調べたところロシアでは2014年10月26日から
標準時の変更があるため日本とイルクーツクとの時差が
変わるとのことでした。
outlook2013では前倒しで実施されていたのかと推測します。
現在ではoutlook.comでもイルクーツクの標準時間がUTC+08:00に
変更されてしまいました

Outlook.com と Outlook 2013 でイルクーツクの標準時間がずれているとの件についてですが、
こちらでも Outlook.com にて確認したところ、
お知らせいただいたようにイルクーツクの時間が UTC+8:00 となっていることを確認しました。

Outlook.com のカレンダーおよび Outlook 2013 の予定表のどちらにも
タイムゾーンを「(UTC+09:00)大阪,札幌,東京」に設定しているのに、
登録する予定がイルクーツクになってしまう件について、
ご提案としてのお話とはなってしまいますが、
現在、Outlook.com のカレンダーと Outlook 2013 の予定表を同期してご利用されている場合、
同期を解除していただき、Outlook.com のカレンダーに直接予定を入力した場合、
タイムゾーンが「(UTC+09:00)大阪,札幌,東京」と設定している内容どおりに、
登録する予定が反映されるかご確認いただくとのお話となります。

イルクーツクのまじめな点

その後のことは不明だが、Outlook.com つまりHotmailを使い、Outlook.exeを電子メールクライアントにしているときにカレンダーのデータが同期しているというのがポイント。

海外でもモンスタークレーマーはいるといえる例

第2木曜日後の第1水曜日に定期的な予定を入れることができないと訴えている例
Outlook/Exchange event that repeats on the first Wednesday after the second Thursday?

3/8/2018 10:22:19 AM Created
Hello,
I need to schedule an event that recurs monthly on the first Wednesday after the second Thursday. I know I cannot create this via the Outlook UI, but I also know that the iCalendar specification supports such a recurrence ([1],[2]), so I have created an .ics file with the following RRULE:
RRULE:FREQ=MONTHLY;BYDAY=WE;BYMONTHDAY=14,15,16,17,18,19,20
When I try to import this .ics file, Outlook 2016 for Mac opens it as an email attachment. I can open it in Calendar.app without trouble. If I subscribe to my Outlook calendar from Calendar.app and move the imported .ics to my Outlook calendar there, the operation fails after warning me that some of the fields are not supported by my Exchange server and will be saved as notes.
If I remove the RRULE statement, Outlook can import the file. Does Exchange/Outlook not support the full flexibility of the iCal specification for RRULE statements?

しかしマイクロソフトの回答が誤っていてまた腰を抜かすほどひどい

あなたのニーズと状況の詳細な説明をありがとう。 ご存知のように、Outlookクライアントからこのような繰り返し会議を設定することはできません。 貴重なご意見やご意見をOutlook for Mac UserVoiceに送信できます。関連チームが喜んでご連絡いたします。
.icsファイルのRRULEがOutlook for Macで機能するかどうかについて、サードパーティのプロパティを.icsファイルに追加/作成することはお勧めしません(私たちはRRULEのプロパティ/構文に精通していません)。 そのような公式記事はそれを言及しました。
先ほど述べたように、Outlook UserVoiceにあなたの考えを送ってください。私たちの関連エンジニアはあなたに気づきます。
わかってくれてありがとう。

Richard Xu MSFT
3/8/2018 3:06:29 PM Marked as answer
Microsoft Agent |
Moderator
Hi Marijane white,
Thanks for your detailed description of your needs and the situation. As you know, we can’t set up such recurrence meeting from Outlook client. You can send your precious thought/comment to our Outlook for Mac UserVoice, our related team will be happy to hear from you.
About if the RRULE in .ics file works in Outlook for Mac, we don’t suggest that you added/created the third-party property into .ics file (we are not familiar with property/syntax about the RRULE) and we have no such official article mentioned it.
As I mentioned, please send your thought to the Outlook UserVoice, our related engineer will notice you.
Thanks for your understanding.
Regards,
Richard

普通の人間はicsやVBAで定期的な予定は扱えない

まずこれが前提。とくにVBAやicsでは無理。自分が使うOutlook、GCalenderなどのGUIで手動で設定したほうがよい。
それをやることで、各アプリケーションがどこまでicsを理解できるかが想像がつくようになります。
icsは複雑な設定、除外日が設定できますが、Outlookの定期的な予定の設定画面に除外日がないことはわかるようになるでしょう。
そしてMajane、Outlookが理解できないという前に、それが第三水曜日だと理解しよう。そうしたらicsを書き換えれば設定できるじゃないか。そしてそれができるでしょう。第2木曜日は14日までに必ず出現する以上、その次の第一水曜日は15日から21日までの間だと知っているじゃないか。どういうソフトでどういう操作をするとそのようなicsファイルが生成されるのかが知りたい。

まあこんな感じですね。Richardの回答「我々はicsに精通していない」、それはありえないよね。下にリンクいっぱいあるよ。間違っているっていえないのかな。

定期的な予定はもう書きつくされている

iCalとiCalendar - 2006/5/1
この時代はappleのicalenderが時代の主流だった。
日本語ベースでここでいろいろなパターンがまとまっている。
歴史の陰りを帯びながら、13年たってもその輝きが消えない。
この例に当てはめるというのが重要。上の問いのようにその書き方では無理だけど第三水曜ならいけるよ、ということがある。
また第5週はできないが、最終週はできる。
icsファイルによる繰り返し予定の入力と例外予定の入力 hack note 2017/
FREQ Valueとして、DAILY、WEEKLY、MONTHLY、YEARLYがあります。毎日とか毎週とか。
UNTIL期限COUNT回数 どちらもないと無期限
INTERVAL 間隔
-1が最終になる
曜日が2文字であらわされる。
SU sunday
MO monday
TU Tuesday
WE Wednessday
TH Thirsday
FR Friday
ST Suturday
BYDAYが曜日指定(Weekly選択時)
BYMONTHDAY 月の何日か、複数ある時はコンマ
BYMONTH 月、複数ある時はコンマ
例外日付はEXDATE:20190921T000000,20191021T000000
OUTLOOKでは例外が効かない。本当は最終週で第4週と同じなら除外できれば第5週のみが可能になるのだが。

しかしEXCELならできる

Excelに連続して並べて、単発の予定としてicsファイルを作るというのはあり得る。というかそのためにExcelで必死にicsファイルを作るようにしているのだから当然である。
もちろん日付計算は難しいが、OUTLOOKの定期的な予定では設定できないようなものは単発の予定としてicsファイルから共有したほうが良い。
というのもOutlookの定期的な予定をVBAで行うのはとても定数が多くて複雑だからである。
これよりは単純な定期的な予定ならGUIで入力するか、icsで入力するほうが早い。

VALarmの例

「iCalendarフォーマットにおけるVALARMコンポーネントについて」 
分単位だけではなく1日単位もできる。JSTを前提とすると、-P1D-PT1D

icsの各項目はOutlookのVersionしだいでも動く、動かない命令がある

icsの設定はいろいろだが、Versionによって動かないものもある
5 Appendix A: Product Behavior
OutlookとExchange Serverのどのバージョンで動くか動かないかを説明している。
ただしOutlook2000以前は記述がない。

Version2.0の根拠

2.1.3.1.1.3 Property: VERSION
‎2019‎年‎02‎月‎15‎日
読了までの所要時間: 2 分
インポートもエクスポートも可能
ただし2.0で固定する。
2.0の根拠がこれ。
またこの表記は

VERSION:2.0

であって

Property:VERSION:2.0

ではない。XML表記では

<version>2.0</version>

となる。

重要度 importance

2.1.3.1.1.20.32 Property: X-MICROSOFT-CDO-IMPORTANCE
‎02‎/‎15‎/‎2019
RFC Reference: N/A
Number of Instances Allowed: 0, 1
Format: Integer (RFC2445 section 4.3.8)
Brief Description: Specifies the importance of an appointment.
Importing to Calendar objects
This property SHOULD be imported into PidTagImportance as specified by the following table.
This property SHOULD be exported as specified in the preceding table.

X-MICROSOFT-CDO-IMPORTANCE PidTagImportance means 意味
0 0x00000000 Low
1 0x00000001 Normal ふつう
2 0x00000002 High マジでやばい

Microsoftの X-WR-CALNAMEの解説

2.1.3.1.1.17 Property: X-WR-CALNAME
Exchange Serverの解説。
単一の予定では読み込まれない。(つまりMSはICSで複数の予定が読み込める)
Outlookは読み込む
02/15/2019
RFC Reference: N/A
Number of Instances Allowed: 0, 1
Format: Text ([RFC2445] section 4.3.11)
Brief Description: Specifies the name of the calendar.
Importing to Calendar objects
This property SHOULD<38> be imported directly into the PidTagDisplayName ([MS-OXPROPS] section 2.672) of the Folder object representing the newly-created destination of the imported appointments. Implementations MAY truncate the value to 255 characters and MAY remove carriage return (Unicode character U+000D) and line feed (Unicode character U+000A) characters.
Exporting from Calendar objects
This property MUST be omitted if the iCalendar represents a single appointment or meeting.
If this iCalendar represents a calendar export, this property SHOULD<39> be set to the value of PidTagDisplayName on the Folder object representing the calendar being exported.
If the calendar is the owner's primary calendar, this property SHOULD<40> instead be set to a more descriptive locale-dependent string containing the owner's name (e.g. 'Elizabeth Andersen calendar').

X-WR-CALDESCはMSはインポートするときに無視する(OUTLOOKは違う)

2.1.3.1.1.16 Property: X-WR-CALDESC
OUTLOOKでは、複数の予定を一つの予定表として読み込んだ場合、予定表のプロパティの説明に表示されます。
02/15/2019
RFC Reference: N/A
Number of Instances Allowed: 0, 1
Format: Text ([RFC2445] section 4.3.11)
Brief Description: Specifies the description of the calendar.
Importing to Calendar objects
This property SHOULD<34> be ignored.
Exporting from Calendar objects
If this iCalendar represents an export of a calendar, and if the owner has provided a description of the calendar, this property SHOULD<35> be set to the owner's specified text, which SHOULD<36> be truncated to a length of 255 WCHARs if the length exceeds 255 WCHARs. The truncation SHOULD NOT<37> split surrogate pairs (as specified in [UNICODE5.1] section 2.5).

Durationで長さを指定するのはインポートはできるがエクスポートは非推奨

朝4時開始で2時間とするのと開始4時、終了6時は同じ意味になる。
しかし、DurationはImportはできるがOutlookから予定をExportするときは非推奨である。
このようにicsのプロパティはVersionでも違うし、インポートとエクスポートで推奨されたりしなかったりする。
おそらくDurationが一番重要な例。

2.1.3.1.1.20.12 Property: DURATION
02‎/‎15‎/‎2019
2 minutes to read
開始日時から30分、1時間という指定方法がある。
RFC Reference: [RFC2445] section 4.8.2.5
Number of Instances Allowed: 0, 1
Format: Duration ([RFC2445] section 4.3.6)
Brief Description: Specifies the duration of an appointment.
Importing to Calendar objects
If only one of DTSTART and DTEND is present, the DURATION property SHOULD<155> be used to compute the missing property.
Exporting from Calendar objects

進捗状況

2.1.3.1.1.20.23 Property: STATUS
‎02‎/‎15‎/‎2019
進捗状況。インポートはできるが、エクスポートはできない。
RFC Reference: RFC2445 section 4.8.1.11
Number of Instances Allowed: 0, 1
Format: Text ([RFC2445] section 4.3.11)
Brief Description: Specifies the confirmation level of the appointment.
Importing to Calendar objects
If PidLidBusyStatus cannot be imported from TRANSP (section 2.1.3.1.1.20.25), X-MICROSOFT-CDO-BUSYSTATUS (section 2.1.3.1.1.20.31), or X-MICROSOFT-MSNCALENDAR-BUSYSTATUS (section 2.1.3.1.1.20.42), this property SHOULD<192> be imported into PidLidBusyStatus as specified in the following table.

MicrosoftのicsにはCDOとMSNCALENDARがある

これが公式のサイトでicalenderの要素に関する検索をややこしくしている

X-WR-TIMEZONEはじゃまか?

https://blog.jonudell.net/2011/10/17/x-wr-timezone-considered-harmful/
X-WR-TIMEZONEは実験的な項目だが、VTIMEZONEの定義の仕方が面倒なので、使うし、Apple系はこれで定義している。
VTIMEZONEは定期的な予定(イベント)における夏時間のために必要。

このタイムゾーンのすべてがなぜ必要なのか疑問に思うかもしれません。 結局、iCalendarフィードでは、VTIMEZONE(および/またはX-WR-TIMEZONE)を単に省略し、日付と時刻をUTC(協定世界時)で表現し、すべての日付と時刻にUTC構文を使用できます。 なぜそれをしないのですか? 私はしばらく前にこれについてダグ・デイに尋ねました、そして、彼の返事はここにありました:

最大の問題は、定期的なイベントと夏時間/標準時間の移行です。 たとえば、次のことを考えてください(すべて仮説的)。

ドイツでのTimezoneの設定例

RDFicalとicalを説明してるサイト

Atendeeは使わんでええ

http://www.rfc-editor.org/rfc/rfc2445.txt
CAL-ADDRESS値タイプ。 このパラメーターは、プロパティー値で指定されたカレンダーユーザーからの応答の期待を識別します。 このパラメーターは、「オーガナイザー」が参加をリクエストするために使用します
グループでスケジュールされたイベントまたは予定の「出席者」からのステータス応答。
このパラメーターを許可するプロパティで指定されていない場合、
デフォルト値はFALSEです。
これを使わない理由は、今回の趣旨があくまでも予定表をicsファイルで共有しようというものであるからです。というかそれはCalenderItemではなくMeetingItemになってしまいます。
OutlookではOrganizerを入れると自動的に会議の予定となり(でもエラーを吐く)、さらにAtendeeの値がないとエラーになり、さらにPRODID:の値を見るようになります。

AlldayEventつまり終日かどうか

2.1.3.1.1.20.41 Property: X-MICROSOFT-MSNCALENDAR-ALLDAYEVENT
02‎/‎15‎/‎2019

終日のイベントかどうか。Trueの場合、StartとEndの日時は無視される。
X-MICROSOFT-CDO-ALLDAYEVENTとX-MICROSOFT-MSNCALENDAR-ALLDAYEVENTは同じ意味

X-MICROSOFT-CDO-ALLDAYEVENTと同じ意味なので、通常はX-MICROSOFT-CDO-ALLDAYEVENTを使う。
RFC Reference: N/A
Number of Instances Allowed: 0, 1
Format: Boolean ([RFC2445] section 4.3.2)
Brief Description: Specifies whether an appointment is intended to be treated as all day.
Importing to and Exporting from Calendar objects
This property is synonymous with X-MICROSOFT-CDO-ALLDAYEVENT.<232> See section 2.1.3.1.1.20.28 for usage.

定期的な予定でない限り出力できない例

2.1.3.1.1.20.39 Property: X-MICROSOFT-EXDATE
定期的な予定ではない限りExportできない
これは定期的な予定に例外を定める日らしい。

予定の空き状況(予定の公開方法)

2.1.3.1.1.20.31 Property: X-MICROSOFT-CDO-BUSYSTATUS
‎02‎/‎15‎/‎2019
2 minutes to read
RFC Reference: N/A
Number of Instances Allowed: 0, 1
Format: Text (RFC2445 section 4.3.11)
rief Description: Specifies the BUSY status of an appointment.
Importing to and Exporting from Calendar objects
This property SHOULD<215> be mapped into PidLidBusyStatus as specified by the following table.

Contact

OutlookはContactが設定されているとアドレス帳と照合してマッチしたアドレスとリンクする
実は何気なく便利かもしれない。

X-MICROSOFT-CDO-BUSYSTATUS PidLidBusyStatus means
FREE 0x00000000 空き時間
TENTATIVE 0x00000001 仮の予定
BUSY 0x00000002 予定あり
OOF 0x00000003

以上を踏まえた詳細版

OUTLOOKではGEOタグは反映されませんが、Descriptionに書き込むようにしました
https://qiita.com/hiron2225/items/8d5cd1b6728b4d63434b
緯度経度は緯度、経度の順にDD形式(+-float)でセミコロンで区切ってください。コンマでもいいです。
カテゴリーはコンマ区切りです。ばらばらになってすいません。

Option Explicit

Sub makesheetform2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim iRow As Long, iCol As Long, LastRow As Long, LastCol As Long, R As Range, URng As Range, Cnt As Long
Dim arRow2, arRow3
Dim DT As Date
DT = Now
If MsgBox("いったん消去します Now Start Clear all OK?", vbOKCancel) = vbOK Then
ws.UsedRange.Clear
arRow2 = Split("summary,StartdateTime,EnddateTime,Location,importance(Normal;High;Low),AlldayEvent(False;TRUE),FreeBusyStatus(TENTATIVE;BUSY;Free),Alarm(0 is none:UNIT=minutes),Description,URL,DD Format Geotag(37.5739497;-85.7399606),Categories(Delimiter is comma),Contact,Priority(5)", ",")
arRow3 = Split("Birthday," & Format(DT + 1, "yyyy/mm/dd 10:00:00") & "," & Format(DT + 1, "yyyy/mm/dd 10:30:00") & ",Home,Nomal,FALSE,TENTATIVE,15,Tisis \n test item,www.google.co.jp,28.0000commaorsemicolon135.0000,Schedule,me,5", ",")

ws.Range("A1").Value = "Project Name:": ws.Range("B1").Value = "icsfilename"
iCol = 1
For Cnt = LBound(arRow2) To UBound(arRow2)
ws.Cells(2, iCol).Value = arRow2(Cnt)
ws.Cells(3, iCol).Value = arRow3(Cnt)
iCol = iCol + 1
Next
End If
End Sub
Sub makeicsfilejp2()
Const OutputDrive = "h:\"
Const OutputFolder = "dbfolder\"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim iRow As Long, iCol As Long, LastRow As Long, LastCol As Long, R As Range, URng As Range
Dim DTSTART As Date, DtEnd As Date
Dim blAlldayEvent As Boolean
Dim sr As ADODB.Stream
Dim oFile As File, oFolder As Folder
Dim MC As MatchCollection, M As Match, sMs As SubMatches, iM As Long
Dim buf As String
Dim FSO As New Scripting.FileSystemObject
Dim icsJapanHeader As String
Dim strRemind As String
icsJapanHeader = _
"BEGIN:VCALENDAR" & vbCrLf & _
"PRODID:-//Microsoft Corporation//Outlook 19.0 MIMEDIR//EN" & vbCrLf & _
"CALSCALE: GREGORIAN" & vbCrLf & _
"x-WR-CALNAME:" & ws.Range("B1").Value & vbCrLf & _
"x-WR-CALDESC:" & "Added ics file :" & ws.Range("B1").Value & ".ics" & vbCrLf & _
"X-WR-TIMEZONE:Asia/Tokyo" & vbCrLf & _
"VERSION:2.0" & vbCrLf & _
"METHOD:Publish" & vbCrLf & _
"BEGIN:VTIMEZONE" & vbCrLf & _
"TZID:Asia/Tokyo" & vbCrLf & _
"BEGIN:STANDARD" & vbCrLf & _
"DTSTART:16010101T000000" & vbCrLf & _
"TZOFFSETFROM:+0900" & vbCrLf & _
"TZOFFSETTO:+0900" & vbCrLf & _
"TZNAME:JST" & vbCrLf & _
"End:STANDARD" & vbCrLf & _
"End:VTIMEZONE"
Const unremind = "END:VEVENT"
Set sr = New ADODB.Stream
With sr
.Mode = adModeReadWrite
.Type = adTypeText
.LineSeparator = adCRLF
.Charset = "utf-8"
.Open
sr.WriteText icsJapanHeader, adWriteLine
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For iRow = 3 To LastRow
.WriteText "BEGIN:VEVENT", adWriteLine
' Organizer と Atendeeは会議の予定になるので使用しないほうが良い。使うときは両方設置する。ProgIDとも関係してくる
'.WriteText "ORGANIZER:MAILTO:.mailadderss@example", adWriteLine
'.WriteText "ATENDEE:MAILTO:.mailadderss@example", adWriteLine
'.WriteText "CLASS:PUBLIC" & vbCrLf & "DESCRIPTION:" & ws.Range("A" & iRow).Value, adWriteLine
DTSTART = ws.Range("B" & iRow).Value
buf = Format(DTSTART, "yyyymmdd""T""hhMMss")
'.WriteText "Created:"":" & buf, adWriteLine 'Outlook importing error
'.WriteText "DTSTAMP:"":" & buf, adWriteLine 'Outlook importing error
.WriteText "DTSTART;TZID=""Asia/Tokyo"":" & buf, adWriteLine
DtEnd = ws.Range("C" & iRow).Value
'buf = Format(DtEnd - CDate("09:00:00"), "yyyymmdd""T""hhMMss""z""")
buf = Format(DtEnd, "yyyymmdd""T""hhMMss") '最後にUTCを表す末尾の「Z」を消せばTZIDで設定した地域のタイムゾーンで読み込まれます。
.WriteText "DTEnd;TZID=""Asia/Tokyo"":" & buf, adWriteLine
If ws.Range("M" & iRow) <> "" Then
.WriteText "CONTACT:" & ws.Range("M" & iRow), adWriteLine
End If
.WriteText "X-MICROSOFT-CDO-BUSYSTATUS:" & ws.Range("H" & iRow), adWriteLine
Select Case LCase(ws.Range("G" & iRow).Value)
Case Is = "busy"
.WriteText "TRANSP:OPAQUE", adWriteLine
Case Else
.WriteText "TRANSP:TRANSPARENT", adWriteLine
End Select

Select Case LCase(ws.Range("E" & iRow).Value)
Case Is = "normal"
.WriteText "X-MICROSOFT-CDO-IMPORTANCE:1", adWriteLine
Case Is = "high"
.WriteText "X-MICROSOFT-CDO-IMPORTANCE:2", adWriteLine
Case Is = "low"
.WriteText "X-MICROSOFT-CDO-IMPORTANCE:0", adWriteLine
End Select

.WriteText "X-MICROSOFT-CDO-ALLDAYEVENT:" & ws.Range("F" & iRow), adWriteLine
.WriteText "SUMMARY;LANGUAGE=ja:" & ws.Range("A" & iRow), adWriteLine 'VBAで設定するときはSubject
buf = ""
'.WriteText "DEScription;LANGUAGE=ja:" & ws.Range("A" & iRow), adWriteLine 'VBAで設定するときはBody
If ws.Range("K" & iRow) <> "" Then
buf = "DESCRIPTION;Language=""ja"":" & ws.Range("I" & iRow) & " \n " & "https://www.google.com/maps/@?api=1&map_action=map&center=" & Replace(ws.Range("K" & iRow).Value, ";", ",", 1, 1, vbBinaryCompare)
.WriteText "GEO:" & Replace(ws.Range("K" & iRow).Value, ";", ",", 1, 1, vbBinaryCompare)
Else
buf = "DESCRIPTION;Language=ja:" & ws.Range("I" & iRow) & vbCrLf
End If
If ws.Range("J" & iRow) <> "" Then
.WriteText "URL;VALUE=URI:" & ws.Range("J" & iRow), adWriteLine
buf = buf & "\n" & vbCrLf & vbTab & ws.Range("J" & iRow)
.WriteText buf, adWriteLine
Else
.WriteText buf, adWriteLine
End If
' Category コンマ区切りのままでもOutlookは複数のカテゴリーとして読み込むためセミコロン区切りは誤った入力として修正。間違うと余計なカテゴリーが増えてしまうので、表記は正確に。全角、半角、大文字、小文字注意。
If ws.Range("L" & iRow) <> "" Then
.WriteText "Categories:" & Replace(ws.Range("L" & iRow), ";", ",", 1, -1, vbTextCompare), adWriteLine
End If

' Priority 通常は5 0は優先度なし。しかし全く表示されないので、空白なら5、0以上の整数なら反映
If CLng(ws.Range("N" & iRow)) >= 0 Then
.WriteText "Priority:" & ws.Range("N" & iRow), adWriteLine
Else
.WriteText "Priority:5"
End If
.WriteText "UID:" & Format(Now, "yyyyMMddThhmmss"), adWriteLine
'sr.WriteText "X-MICROSOFT-DISALLOW-COUNTER:FALSE" & vbCrLf & _
"X-MS-OLK-AUTOFILLLOCATION:FALSE", adWriteLine
If ws.Range("H" & iRow) <> 0 Then
strRemind = "BEGIN:VALARM" & vbCrLf & _
"TRIGGER:-PT" & ws.Range("H" & iRow) & "M" & vbCrLf & _
"ACTION:Display" & vbCrLf & _
"DESCRIPTION:Reminder" & vbCrLf & _
"End:VALARM" & vbCrLf & _
"END:VEVENT"
.WriteText strRemind, adWriteLine
Else
.WriteText unremind, adWriteLine
End If
Next
.WriteText "END:VCALENDAR"
If FSO.FolderExists(OutputDrive & OutputFolder) Then
Set oFolder = FSO.GetFolder(OutputDrive & OutputFolder)
If FSO.FileExists(oFolder.Path & "\" & StrConv(ws.Range("B1").Value, vbNarrow) & ".ics") Then FSO.DeleteFile oFolder.Path & "\" & StrConv(ws.Range("B1").Value, vbNarrow) & ".ics"
If Len(oFolder.Path & "\" & StrConv(ws.Range("B1").Value & ".ics", vbNarrow) & ".ics") <= 255 Then
.SaveToFile oFolder.Path & "\" & StrConv(ws.Range("B1").Value, vbNarrow) & ".ics", adSaveCreateNotExist
End If
End If
End With
End Sub

最後にちゃぶ台をひっくり返すけど

これを書いている人は紙の手帳です。もう同期に疲れ果て、電池切れに疲れ果て、バージョンアップに疲れ果て、機種変更に疲れ果てました。
電子が役立つのは定期的な予定で、とくに数年ごとの予定です。もしくはインターバルが数日から1週間前後の間隔で続き、一つの予定がずれるとあとがずれるというような一連のグループスケジュールです。こうした日数を計算させるのにExcelは向いています。なので最強のスケジューラーはExcelであり、その下にOUTLOOK、GOOGLE、Appleはいるのです。それを保証するのがこのics作成マクロです。そしてそうした複雑なもの以外は、紙が一番です。
紙>Excel > outlook google apple
やはりMicrosoft Projectが安くならないとMicrosoftに逆転はないかもなあ。

付録 定期的な予定を組むときに必要な定数の地獄

icsファイル定期的な予定で使用する曜日の略称

SU sunday
MO monday
TU Tuesday
WE Wednessday
TH Thirsday
FR Friday
ST Suturday

月の場合は1,2,3と番号でのみあらわされる。

DayOfWeekType Enum
フィールド 意味
Day 7 定期的なパターンの一部として毎日を識別します。 この値が設定されていない、RelativeYearlyRecurrencePatternTypeまたは、 WeeklyRecurrencePatternType。
Friday 5 金曜日が定期的なパターンの一部であることを識別します。
Monday 1 月曜日が定期的なパターンの一部であることを識別します。
Saturday 6 毎週土曜日が定期的なパターンの一部であることを識別します。
Sunday 0 毎週日曜日が定期的なパターンの一部であることを識別します。
Thursday 4 木曜日が定期的なパターンの一部であることを識別します。
Tuesday 2 火曜日が定期的なパターンの一部であることを識別します。
Wednesday 3 水曜日が定期的なパターンの一部であることを識別します。
Weekday 8 平日が定期的なパターンの一部であることを識別します。 この値が設定されていない、RelativeYearlyRecurrencePatternTypeまたは、 WeeklyRecurrencePatternType。
WeekendDay 9 定期的なパターンの一部として、週末の日付を識別します。 この値が設定されていない、RelativeYearlyRecurrencePatternTypeまたは、 WeeklyRecurrencePatternType。

DayOfWeekIndexType Enum

フィールド 意味
First 0 定期的なパターンで、月の最初の週が使用されることを示します。
Second 1 月の第2週が定期的なパターンで使用されることを示します。
Third 2 月の第 3 週が定期的なパターンで使用されることを示します。
Fourth 3 月の第4週が定期的なパターンで使用されることを示します。
Last 4 月の最後の週が定期的なパターンで使用されることを示します。
2
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
1