質問
2016年6月27日月曜日 8:04
Exchange環境にてOutlook2013を使用しています。
特定のアカウントでログインし、別の複数ユーザ（30人程度）の予定表をcsvでエクスポートするVBAを構築しました。
作業日を起点に前後2週間をエクスポートしたいのですが、途中まで処理した後でエラーメッセージが表示され、
処理が中断してしまいます。
エラーメッセージ：
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
-2147352567（800200009）
Startは不明なプロパティです
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
エラーの後、csvを確認すると、大体1人目の180件ほどをエクスポートしていました。
以下にソースを記述しますので、ご教示いただければ幸いです。
どうぞよろしくお願いいたします。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
Public Sub ExportOhtersCalendar()
Dim dtExport As Date
Dim strStart As String
Dim strEnd As String
Dim objFSO 'As FileSystemObject
Dim stmCSVFile 'As TextStream
Dim strUserName As String
Dim objRecip As Recipient
Dim colAppts As Items
Dim objAppt 'As AppointmentItem
Dim strLine As String
Dim i As Integer
Const CSV_FILE_NAME = "C:\保存先パス\Outlook.csv" ' エクスポートするファイル名を指定してください。
Dim arrUsers As Variant
'＝＝＝＝＝＝＝＝＝＝以下にユーザ名を記述します。必要に応じて追加修正してください。＝＝＝＝＝＝＝＝＝＝
arrUsers = Array("ユーザ1 ", "ユーザ2 ", "ユーザ3 ", "ユーザ4 ", "ユーザ5 ", _
"ユーザ6 ",,,,,)
dtExport = Now
strStart = Year(DateAdd("ww", -2, CDate(dtExport))) & "/" & Month(DateAdd("ww", -2, CDate(dtExport))) & "/" & Day(DateAdd("ww", -2, CDate(dtExport)))
strEnd = Year(DateAdd("ww", 2, CDate(dtExport))) & "/" & Month(DateAdd("ww", 2, CDate(dtExport))) & "/" & Day(DateAdd("ww", 2, CDate(dtExport)))
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set stmCSVFile = objFSO.CreateTextFile(CSV_FILE_NAME, True)
stmCSVFile.WriteLine """ユーザー"",""件名"",""場所"",""開始日時"",""終了日時"",""分類項目"",""内容"",""主催者"",""必須出席者"""
For i = LBound(arrUsers) To UBound(arrUsers)
strUserName = arrUsers(i)
Set objRecip = Application.Session.CreateRecipient(strUserName)
objRecip.Resolve
If Not objRecip.Resolved Then
MsgBox "ユーザーが特定できませんでした。", vbCritical, "共有されている予定表のエクスポート"
Exit Sub
End If
Set colAppts = Application.Session.GetSharedDefaultFolder(objRecip, olFolderCalendar).Items
colAppts.Sort "[Start]"
colAppts.IncludeRecurrences = True
Set objAppt = colAppts.Find("[Start] < """ & strEnd & """ AND [End] >= """ & strStart & """")
While Not objAppt Is Nothing
strLine = """" & objRecip.Name & _
""",""" & objAppt.Subject & _
""",""" & objAppt.Location & _
""",""" & objAppt.Start & _
""",""" & objAppt.End & _
""",""" & objAppt.Categories & _
""",""" & objAppt.Body & _
""",""" & objAppt.Organizer & _
""",""" & objAppt.RequiredAttendees & _
""""
stmCSVFile.WriteLine strLine
Set objAppt = colAppts.FindNext
Wend
Next
stmCSVFile.Close
MsgBox "作業完了！", vbOKOnly, "～Fin.～"
End Sub
すべての返信 (4)
2016年7月26日火曜日 4:28 ✅回答済み
こんにちは。
> Set objAppt = colAppts.Find("[Start] < """ & strEnd & """ AND [End] >= """ & strStart & """")
ItemsオブジェクトFindメソッドの戻り値をObject型(提示されたコードではVariant)の変数objApptにセットしています。
> エラー箇所で指定している［Start］が、どのオブジェクトのプロパティであるのかが理解できておらず、
> また、どのように修正すればいいのかがよくわかりません。
予定表フォルダー(olFolderCalendar)の中にあるAppointmentItemの情報を取得したいのだと思いますが、該当フォルダー内にはAppointmentItem以外のアイテム(MeetingItemとか？)があり、そのアイテムを処理しようとした時点で、取得したいプロパティが無く、処理が止まってしまうのでしょう。
手っ取り早く処理するのであれば、エラー箇所の前に「On Error Resume Next」(http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_error.html)を入れれば、処理が止まらないようにできるだろうと思います。
2016年6月27日月曜日 8:17
こんにちは。
Items.Findメソッドで返されるOutlookアイテム(オブジェクト型)がStartプロパティをサポートしていないのだと思います。
躓いているアイテムの種類を確認してみてはいかがでしょうか？
Outlook アイテム オブジェクト：
https://msdn.microsoft.com/ja-jp/library/ff866278.aspx
2016年7月21日木曜日 10:27
返信いただきましてありがとうございます。
また、レスポンスが遅くなりまして申し訳ございません。
いただいたヒントを元に調査・検;を行い、コードのどの部分でエラーになるかは特定できましたが、
当方のスキルがさほど高くないこともあり、「どのように修正を加えたらいいのか」で止まっております。
「オブジェクトがStartプロパティをサポートしていない」の意味は理解できますが、
エラー箇所で指定している［Start］が、どのオブジェクトのプロパティであるのかが理解できておらず、
また、どのように修正すればいいのかがよくわかりません。
大変恐縮ではございますが、改めてご教示いただければと思います。
※恥ずかしながら、そもそも、このソースが何をどこにSetしているのかが理解できておりません。
【エラー箇所】
Set objAppt = colAppts.Find("[Start] < """ & strEnd & """ AND [End] >= """ & strStart & """")
どうぞよろしくお願いいたします。
2016年11月7日月曜日 7:58
返信が大変遅くなりまして申し訳ございません。
ご教示いただいた「On Error Resume Next」にてエラーを回避し、
抽出できたデータを集計して、問題なしとの結論になりました。
長々と質問を引っ張りまして恐縮です。
どうもありがとうございました。