VBA Excel将日期单元格与Outlook日历事件同步 | Excel将日期单元格与Outlook日历事件同步

本文介绍了VBA Excel将日期单元格与Outlook日历事件同步的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

下午好，

我一直在努力通过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

另一个选项来自这里:

使用VBA确定选定的Outlook日历日期

但是即使我使用的是纯代码，也会出现错误:"对象不支持此属性或方法".

 设置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日历事件同步的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！