VBA Excel将日期单元格与Outlook日历事件同步 [英] VBA Excel synchronising the date cells with Outlook calendar events
问题描述
下午好，
我一直在努力通过MS Excel与Outlook日历同步.我想让带有日期的单元格作为事件出现在此日历中.
我为此找到的最佳代码来自这里:
如果我将原始声明保留为 Date ，请按照以下说明操作
子Calendaroutlookevent()昏暗的objOutlook作为Outlook.Application昏暗的objNamespace作为Outlook.Namespace昏暗的项目作为Outlook.Folder，objCalendar作为Outlook.Folder，objapt作为Outlook.Folderconst olFolderCalendar = 9const olAppointmentItem = 1'1 =约会设置objOutlook = CreateObject("Outlook.Application")'Set objOutlook = GetObject(，"Outlook.Application")'Outlook已打开设置objNamespace = objOutlook.GetNamespace("MAPI")设置项目= objNamespace.GetDefaultFolder(olFolderCalendar).items设置objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")设置objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar)'主日历设置objapt = objCalendar.items.add(olAppointmentItem)objapt.Subject =测试"'所有者objapt.Start =日期+ TimeValue("08:00:00")objapt.Duration = 60 * 8'Duration(以分钟为单位)或End(我不确定，请同时尝试两者)objapt.End =日期+ TimeValue("16:00:00")objapt.Save结束子 然后调试器针对以下行说类型不匹配" :
设置项目= objNamespace.GetDefaultFolder(olFolderCalendar).items 另一个选项来自这里:
但是即使我使用的是纯代码，也会出现错误:"对象不支持此属性或方法".
设置oExpl = Application.ActiveExplorer 如何解决此问题并使日期显示在Outlook日历中?我还可以扩大范围，包括测量员的姓名吗?
感谢&问候
更新:
我的代码的最新版本如下:
子Calendaroutlookevent()昏暗的objOutlook作为Outlook.Application昏暗的objNamespace作为Outlook.Namespace将项目作为Outlook.items变暗昏暗objCalendar作为Outlook.Folder，objapt作为Outlook.Folderconst olFolderCalendar = 9const olAppointmentItem = 1'1 =约会设置objOutlook = CreateObject("Outlook.Application")'Set objOutlook = GetObject(，"Outlook.Application")'Outlook已打开设置objNamespace = objOutlook.GetNamespace("MAPI")设置项目= objNamespace.GetDefaultFolder(olFolderCalendar).items设置objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar)'main压延机设置项目= objCalendar.items设置objapt = items.add(olAppointmentItem)objapt.Subject =测试"'所有者objapt.Start =日期+ TimeValue("08:00:00")objapt.Duration = 60 * 8'Duration(以分钟为单位)或End(我不确定，请尝试两个都)objapt.End =日期+ TimeValue("16:00:00")objapt.Save结束子 我得到类型不匹配，因为调试器突出显示了这一行:
设置objapt = items.add(olAppointmentItem) 首先，您需要正确声明对象:
将项目作为Outlook.Items进行昏暗 第二，不需要两次访问相同的对象:
设置项目= objNamespace.GetDefaultFolder(olFolderCalendar).items设置objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")设置objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar)'主日历设置objapt = objCalendar.items.add(olAppointmentItem) 您可以改用以下代码:
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar)'主日历设置项目= objCalendar.Items设置objapt = items.add(olAppointmentItem)objapt.Subject =测试"'所有者objapt.Start =日期+ TimeValue("08:00:00")objapt.Duration = 60 * 8'Duration(以分钟为单位)或End(我不确定，请同时尝试两者)objapt.End =日期+ TimeValue("16:00:00")objapt.Save 最后，您可能会找到在Office中使用VBA 文章很有帮助.
Good afternoon,
I have been struggling with synchronization with the Outlook calendar with MS Excel. I want exactly to have my cells with date appeared in this calendar as the events.
The best code, which I found for this purpose comes from here:
Excel Create an Outlook calendar event
However, the question is closed, as the code is incomplete.
Trying this code on my example
Sub Calendaroutlookevent()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim items As Outlook.Folder, objCalendar As Outlook.Folder, objapt As Outlook.Folder
Dim wb As Workbook
Dim ws As Worksheet
Dim Dt As Date
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set Dt = ws.Range("B2:C6") ' Dates with surveyors included. Maybe some Match option here?
Const olFolderCalendar = 9
Const olAppointmentItem = 1 '1 = Appointment
Set objOutlook = CreateObject("Outlook.Application")
'Set objOutlook = GetObject(, "Outlook.Application") ' outlook already open
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set objapt = objCalendar.items.add(olAppointmentItem)
objapt.Subject = "Test" 'Owner
objapt.Start = Dt + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End = Dt + TimeValue("16:00:00")
objapt.Save
End Sub
Now the debugger shows "Object required" pointing the line: Set Dt = ws.Range("C2:C6")
If I keep the original statement with Date, as per below then
Sub Calendaroutlookevent()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim items As Outlook.Folder, objCalendar As Outlook.Folder, objapt As Outlook.Folder
Const olFolderCalendar = 9
Const olAppointmentItem = 1 '1 = Appointment
Set objOutlook = CreateObject("Outlook.Application")
'Set objOutlook = GetObject(, "Outlook.Application") ' outlook already open
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set objapt = objCalendar.items.add(olAppointmentItem)
objapt.Subject = "Test" 'Owner
objapt.Start = Date + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End = Date + TimeValue("16:00:00")
objapt.Save
End Sub
Then debuggers say "Type-mismatch" for the following line:
Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items
Another option comes from here:
Determining selected Outlook Calendar date with VBA
but even if I use this pure code, I am getting the error: "Object doesn't support this property or method" pointing the line:
Set oExpl = Application.ActiveExplorer
How can I solve this problem and make my dates appeared on the Outlook Calendar? Can I expand my range including the Surveyor name also?
Thanks & Regards
UPDATE:
The newest version of my code looks as follows:
Sub Calendaroutlookevent()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim items As Outlook.items
Dim objCalendar As Outlook.Folder, objapt As Outlook.Folder
Const olFolderCalendar = 9
Const olAppointmentItem = 1 '1 = Appointment
Set objOutlook = CreateObject("Outlook.Application")
'Set objOutlook = GetObject(, "Outlook.Application") ' outlook already open
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main
calender
Set items = objCalendar.items
Set objapt = items.add(olAppointmentItem)
objapt.Subject = "Test" 'Owner
objapt.Start = Date + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try
both)
objapt.End = Date + TimeValue("16:00:00")
objapt.Save
End Sub
I am getting Type Mismatch, as debugger highlights the line:
Set objapt = items.add(olAppointmentItem)
First of all, you need to declare objects properly:
Dim items As Outlook.Items
Second, there is no need to access the same objects twice:
Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set objapt = objCalendar.items.add(olAppointmentItem)
You can use the following code instead:
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set items = objCalendar.Items
Set objapt = items.add(olAppointmentItem)
objapt.Subject = "Test" 'Owner
objapt.Start = Date + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End = Date + TimeValue("16:00:00")
objapt.Save
Finally, you may find the Getting started with VBA in Office article helpful.
这篇关于VBA Excel将日期单元格与Outlook日历事件同步的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
